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资深 软件 开发 专家 根据 自己 十 余年 VBA 开发 经 验 ， 通 过 本 书 深 入 阐释 Office VBA 开发 。 相 比 于 基 
础 入门 卷 ， 本 书 的 内 容 体 系 更 加 完善 ， 知 识 点 更 高 阶 ， 以 VBA 中 添加 和 使 用 外 部 引用 为 主线 ， 详 细 讲 
述 使 用 VBA 操作 和 读 写 Office 文档 之 外 的 内 容 ， 案 例 丰富 ， 让 读者 身 临 其 境 ， 体 会 VBA 编程 的 策略 
和 魅力 。 

本 书 内 容 丰 富 、 实 用 性 强 ， 实 例 典 型 且 有 代表 性 ， 可 以 帮助 读者 轻松 熟悉 VBA 编程 ， 系 统 学 习 
VBA 编程 的 每 个 层面 。 全 书 分 为 14 章 ， 内 容 包括 文件 和 路 径 操作 、 文 件 系统 自动 化 、 压 缩 文 件 处 理 、 
XML 操作 、 自 定义 功能 区 、 正 则 表达 式 使 用 方式 、 字 典 使 用 方法 、 数 据 库 操作 、Office VBA 混合 编程 、 
工程 引用 与 外 部 对 象 、Acrobat 对 象 操作 、 邮 件 处 理 、 网 页 自动 化 等 。 书 中 所 有 章节 涉及 的 程序 代码 都 
给 出 了 详细 注释 。 

本 书 可 作为 职场 办 公 人 员 、 高 校 理工 科 师 生 、Office 专业 开发 人 员 自 学 用 书 ， 也 可 作为 Office 编程 
培训 讲师 的 教学 参考 书 。 
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Office VBA 编程 在 全 世界 范围 已 经 非常 普及 和 流行 ， 办 公 人 员 轻 轻 地 按 下 【 Alt+F11 】 
快捷 键 ， 通 过 录制 宏 就 能 开启 VBA 编程 之 旅 。 

VBA 的 最 简单 应 用 莫 过 于 循环 处 理工 作 每 、 工 作 表 和 单元 格 数据 。 然 而 ，Excel 中 的 
数据 只 是 日 常 办 公 的 一 小 部 分 内 容 ， 很 多 数据 存储 在 各 种 各 样 的 文件 中 ， 例 如 记事 本 文件 、 
CSV 文件 、PDF 文件、 数据 库 等 ， 我 们 不 得 不 每 天 双击 打开 一 个 文件 ， 手 工 编辑 修改 ， 然 
后 关闭 保存 。 随 着 大 数据 时 代 、 信 息 化 时 代 的 迅速 发 展 ， 自 动 化 、 智 能 化 办 公 成 为 大 势 所 
趋 。 为 此 ， 我 们 要 对 手动 办 公 说 :“No !” 

作者 根据 自身 工作 经 历 ， 深切 体会 到 文件 系统 自动 化 的 必要 性 和 重要 性 ， 用 VBA 操作 
Excel 对 象 还 不 能 充分 发 挥 VBA 的 魅力 。 因 此 ， 本 书 以 文件 (Files) 为 操作 对 象 ， 以 外 部 引 
用 (Reference) 为 操作 手段 ， 深 刻 曾 述 : 

口 文本 文件 的 读 写 。 

口 文件 、 路 径 的 增删 。 

口 注册 表 的 读 写 。 

口 压 缩 和 解压 缩 。 

口 XML 与 Office 界面 。 

口 正则 表达 式 处 理 字符 串 。 

口 字 典 的 特色 和 作用 。 

口 ADO 访问 数据 库 、SQL 查询 语句 。 

口 不 同 Office 组 件 的 互相 访问 和 通信 。 

口 工程 引用 与 外 部 对 象 。 

口 Acrobat 软件 和 PDF 文档 自动 化 。 

口 自动 发 送 邮件 。 

口 网 页 自动 化 和 网 页 数据 获取 。 

这 是 进一步 提高 VBA 编程 技术 的 必 有 经 之 路 。 
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本 书 的 组 织 结构 

全 书 共 分 为 14 章 。 

第 1 章 介绍 文本 文件 的 多 种 读 写 方式 、 路 径 和 文件 的 自动 化 处 理 。 

第 2 章 介绍 自动 启动 其 他 应 用 程序 的 方法 、 注 册 表 的 读 写 、 环 境 变 量 的 读 写 方法 。 

第 3 章 分 别 介 绍 用 WinRAR 和 Shell32 自动 处 理 压 缩 文 件 ， 以 压缩 文件 的 视角 认识 
Office 文档 。 

第 4 章 介绍 XML 的 语法 规则 ， 使 用 XML DOM 对 象 读 写 XML 文件 ，XML 文件 的 验 
证 等 。 该 章 是 Office 自 定 义 界 面 的 理论 基础 。 

第 $ 章 介 绍 Office 界面 五 大 功能 区 的 customUI 技术 ,详细 讲解 了 用 于 定制 Office 界面 
各 种 控件 的 技术 要 点 。 

第 6 章 介绍 VBA 编程 中 正则 表达 式 的 用 法 ， 通 过 丰富 的 实例 演示 和 体现 了 正则 表达 式 
在 VBA 编程 中 的 强大 之 处 。 

第 7 章 介绍 字典 的 构成 和 特点 ， 详 细 讲 解 键 值 对 的 添加 、 删 除 、 修 改 、 检 索 的 技巧 和 注 
意 点 。 

第 8 章 介绍 使 用 ADO 技术 访问 Access 、Excel 数据 库 ， 讲 解 最 常用 的 SQL 语句 。 

第 9 章 介绍 跨 Office 组 件 编程 ， 讲 解 前 期 绑 定 和 后 期 绑 定 的 区 别 ， 以 及 不 同 Office 组 件 
之 间 的 互相 访问 。 

第 10 章 介 绍 VBA 工程 中 引用 的 自动 添加 和 移 除 ， 外 部 对 象 的 创建 方法 。 

第 11 章 介绍 使 用 VBA 调用 Acrobat 对 象 ， 对 Acrobat 软件 以 及 PDF 文件 进行 读 写 。 

第 12 章 介 绍 邮箱 的 SMTP 配置 、 使 用 CDO 对 象 自动 创建 和 发 送 邮件 。 

第 13 章 介 绍 HIML DOM 读 写 网 页 ，WebBrowser 和 Internet Explorer 实现 网 页 自动 化 ， 
以 及 XMLHTTP 和 WinHttp 实现 HITP 请 求 。 

第 14 章 介绍 VBA 编程 中 遇 到 的 其 他 常见 话题 : 随机 数 、 颜 色 和 进 制 转 换 、 日 期 时 间 
方面 的 计算 。 


本 书 的 特点 

口 编排 合理 、 内 容 丰 富 。 

口 针对 性 的 实例 比较 多 ,知识 点 讲解 透彻 。 

口 实用 性 强 ， 讲 解 的 知识 范围 面向 广大 计算 机 办 公 人 员 所 需 。 


本 书 的 读者 对 象 

口 职场 中 使 用 计算 机 的 办 公 人 员 。 

口 各 类 学 校 的 教师 、 学 生 、 科 研 人 员 。 

口 从 事 VBA 开发 、VSTO 开发 的 相关 人 员 。 

本 书 使 用 环境 

本 书 的 写作 环境 为 Windows 7 ( 32 位 ) + Microsoft Office 2013。 不 过 本 书 内 容 在 Office 
2010 及 其 以 上 版 本 均 兼 容 。 


配套 资源 

本 书 配套 资源 包括 : 

口 书 中 涉及 的 所 有 实例 文档 。 

口 开 发 资源 (编程 过 程 中 用 到 的 工具 、 软 件 )。 

扫描 右 侧 二 维 码 访问 上 述 资源 。 

读者 服务 

为 方便 广大 读者 学 习 和 探讨 ， 读 者 可 以 通过 扫描 右 侧 二 维 码 获得 更 多 
信息 。 

建议 学 习 方 法 

本 书 各 章 内 容 具 有 相当 的 难度 和 深度 ， 其 中 第 1、2、5 ~ 9 章 为 必 学 内 容 ， 其 余 7 章 为 
选修 内 容 。 读 者 可 根据 自身 所 需 和 兴趣 选择 学 习 。 

对 于 书 中 讲述 的 每 个 知识 点 ， 读 者 应 清楚 其 目的 和 意义 ， 实 现 的 思路 和 方法 ， 运 行 结果 
的 分 析 等 环节 。 

在 实际 学 习 过 程 中 ， 读 者 可 以 从 书 中 找到 对 应 的 实例 文档 ， 直 接 调 试 、 运 行 范例 中 的 
宏 ， 更 便捷 地 体会 程序 设计 的 魅力 。 

致 读者 

VBA 是 微软 Office 软件 配套 的 一 门 编程 语言 ， 是 处 理 文档 、 电 子 表 格 的 首选 语言 。 实 
际 上 ，VBA 不 光 能 处 理 、 解 决 Offce 方面 的 问题 ， 通 过 添加 外 部 引用 ， 还 可 以 操作 和 读 写 
Office 以 外 的 很 多 内 容 。 外 部 对 象 库 的 引入 使 得 VBA 如 虎 添 翼 ， 使 用 恰当 的 外 部 引用 解决 
实际 问题 ， 让 编程 变 得 更 加 简单 、 专 业 。 

作者 根据 自身 多 年 的 学 习 和 研究 经 验 ， 把 平时 用 到 最 多 的 外 部 引用 和 对 象 以 具体 实例 的 
形式 编 成 此 书 。 

本 书 从 立意 到 写作 、 交 稿 历时 一 年 之 入， 融入 作者 大 量 精 力 和 心血 。 衷 心 希 望 广大 读者 
能 够 从 本 书 汲取 营养 、 查 漏 补缺 ， 达 到 学 以 致 用 的 效果 。 

致谢 

在 本 书 的 编写 过 程 中 ， 除 了 刘 永 富 、 刘 行 外 ， 参 与 编写 的 人 员 还 有 戴 海 东 、 曹 文 丽 、 李 
白 等 。 在 编写 过 程 中 难免 会 有 玻 漏 之 处 ， 欢 迎 读者 通过 清华 大 学 出 版 社 网 站 www.tup.com.cn 
与 我 们 联系 ， 帮 助 我 们 改正 提高 。 

在 本 书 的 出 版 过 程 中 ， 得 到 了 清华 大 学 出 版 社 策划 编辑 秦 健 的 大 力 支持 和 配合 ， 在 此 表 
示 囊 心 感谢 。 另 外 ， 本 书 所 有 的 编审 、 发 行人 员 为 本 书 的 出 版 和 发 行 付出 了 辛勤 劳动 ， 在 此 
一 并 致谢 。 


刘 永 富 
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第 1 章 


文件 和 路 径 操作 


我 们 每 天 使 用 计算 机 处 理 最 多 的 就 是 文件 和 路 径 这 两 类 对 象 ， 从 Visual Basic 的 第 一 版 
至 今 ， VB/VBA 中 有 关 文 件 的 处 理 都 是 通过 使 用 Open 、Write 以 及 其 他 一 些 相关 的 语句 和 郴 
数 来 实现 的 。 

随 着 软件 技术 的 不 断 发 展 ， 加 上 面向 对 象 编程 概念 的 日 至 成 熟 ， 这 些 文件 操作 语句 已 经 
不 能 适应 软件 不 断 增 加 的 复杂 程度 的 需要 。 因 此 ， 从 VB6.0 开始 ， 微 软 提 出 了 一 个 全 新 的 
文件 系统 对 象 FileSystemObject (简称 FSO ) 。 

本 章 主要 介绍 通过 如 下 三 种 方式 来 处 理 文件 和 路 径 。 

口 使 用 传统 方式 。 

口 使 用 文件 系统 对 象 FileSystemObject (FSO) 对 象 。 

口 使 用 Shell 语句 调用 DOS 命令 。 

本 章 用 到 的 外 部 引用 和 重要 对 象 如 下 。 

口 Microsoft Scripting Runtime 


口 Scripting.FileSystemObject 

口 Scripting.TextStream 

口 Microsoft ActiveX Data Objects 2.8 Library 
口 ADODB.Stream 

口 Microsoft XML, v6.0 

口 MSXML2.XMLHTTP60 


1.1 使 用 传统 方式 


使 用 传统 方式 可 以 访问 文件 和 路 径 ， 对 文本 文件 和 二 进 制 文件 进行 读 写 。 最 常用 的 函数 
和 命令 如 下 。 
口 Dir: 用 于 列举 路 径 下 的 文件 和 子 文件 夹 名 称 。 
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口 GetAttr 和 SetAttr: 获取 和 设置 属性 。 
口 FileCopy、Name、MkDir 等 : 对 文件 和 路 径 复制 、 移 动 等 。 
口 Open...Write...Close: 对 文本 文件 、 二 进 制 文件 进行 打开 、 读 写 、 关 闭 。 


1.1.1 获取 文件 或 路 径 的 属性 


右 击 文件 、 文 件 夹 ， 在 弹出 菜单 中 选择 属性 命令 ， 打 开 属 性 窗口 后 ， 可 以 设置 只 读 属性 
和 隐藏 属性 等 。 

GetAttr 函数 用 来 获取 和 判断 文件 或 路 径 的 属性 ， 该 函数 的 参数 是 一 个 路 径 字符 串 ， 返 
回 值 是 由 多 个 2 的 整数 寡 的 组 合 相 加 的 总 和 ， 如 表 1-1 所 示 。 


表 1-1 文件 、 路 径 的 属性 常量 


常数 值 描述 
vbNormal 0 常规 
vbReadOnly lL 只 读 
vbHidden 区 隐藏 
vbSystem 4 系统 文件 
vbDirectory 16 目录 或 文件 夹 
vbArchive 32 上 次 备份 以 后 ， 文 件 已 经 改变 
vbalias 64 指定 的 文件 名 是 别名 


这 里 假定 磁盘 下 的 TE.txt 文本 文件 已 设置 为 “只 读 ” 并 且 “ 隐 藏 ”， 如 图 1-1 所 示 。 


yg 


@O?, Hm , sr) » tmp » abcd 


组 织 > ”局 打 开 ” 打印 。 电子 名 件 。 新 建文 件 交 
| -本 3 修改 日 期 3 
马 下 载 | 四 pea 2017/3/30 19:34 。 文本 文档 
LE WD IPconfigexe 2017/3/30 19:34 。 应 用 程序 
四 PP TEtt 2017/11/25 1449 。 文 李 文档 
全 OneDrive 、TEbd 尾 性 
司库 
日 视 须 TE txt 
国画 上 二 | 
国文 村 文件 类 型 。 文本 文档 《 tx) 
db 入 或: 周记 本 
动 言 乐 B 
位 置 Creepvabed 
网 家 大 小 0 字 节 
占用 空间 。 0 字 节 
(sse 时间。 201 年 1 月 5 日， 14:49:2 
人 信 时 间 :20 年 11 月 5 昌 ,14:49:28 
a | 访 本 后 :2017 年 11 月 25 日 ，14:49:28 
号 二 (DY) | 
与 作品 (E | 属性 国 只 读 四 。 园 隐 藏 o E:T 
局 软件 (有 
WW My Web Sites on N 
季风 二 ee 
由 [em 应 用 内 


图 1-1 查看 文件 属性 
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此 时 ，GetAttr("C:\temp\abcd\TE.txt") 会 返回 一 个 整数 35。 其 实 ，35=32 (vbArchive) +2 
(vbHidden) +1 (vbReadOnly), 

因此 ， 把 GetAttr 函数 的 计算 结果 拆 分 为 多 个 枚 举 常量 值 之 和 ， 就 可 以 得 知 该 文件 的 属性 。 

下 面 的 过 程 用 来 把 任何 一 个 正 整数 拆 分 为 多 个 2 的 乘 方 。 


Sub SplitAttributes() 
n= 13 
Do Until n = 0 
i= 2 Int(Log(n) / Log(2) 
n=n-i 
Debug.Print i 
Loop 
End Sub 


运行 上 述 过 程 ， 可 以 看 到 13 被 拆 分 为 8+4+1。 根 据 这 个 思路 ， 可 以 设计 一 个 用 来 判断 
文件 是 否 被 设置 为 只 读 的 自 定义 函数 。 


Function IsReadonly(Path As String) Rs Boolean 
n = GetAttr (Path) 
Do Until n=0 
i=2^Int(Log(n) / Log(2)) 
n=n-i 
IE i = VBA.VbFileAttribute.vbReadOonly Then 
IsReadonly = True 
Exit Function 
End If 
Loop 
End Function 


这 个 函数 的 原理 就 是 把 GetAttr 的 结果 拆 分 为 多 个 数字 ， 拆 分 的 过 程 中 ， 看 看 是 否 有 一 
个 拆 分 恰好 等 于 枚 举 常 量 vbReadOnly， 如 果 有 就 提前 退出 函数 ， 返 回 True。 

运行 Debug.Print IsReadOnly("C:\temp\abcd\TE.txt")， 在 立即 窗口 返回 结果 Tme， 表明 
这 是 一 个 只 读 文件 。 

同 理 ， 把 上 述 函 数 中 的 ReadOnly 这 个 单词 替换 为 Hidden， 就 形成 了 可 以 判断 文件 或 路 
径 是 否 设置 了 隐藏 属性 。 


Function IsHidden(Path As String) As Boolean 
n= GetAttr (Path) 
Do Until n=0 
i= 2 Int(Log(n) / Log(2)) 
入 志 省 二 :下 
If i = VBA.VbFileAttribute.vbHidden Then 
IsHidden = True 
Exit Function 
End If 
Loop 
End Function 


这 里 假定 C: 盘 下 的 Build 文 件 夹 被 设置 了 隐藏 属性 ， 那 么 Debug.Print IsHidden("C\ 
BuildW") 返回 结果 True。 


有 Office VBA 开发 经 典 一 一 中 级 进 阶 卷 


下 面 的 函数 可 以 判断 一 个 路 径 是 否 为 文件 夹 。 


Function IsDirectory(Path As String) As Boolean 
n = GetAttr (Path) 
Do Until n=0 
i= 2 Int(Log(n) / Log(2)) 
n=n-i 
IE i = VBA.VbFileAttribute.vbDirectory Then 
IsDirectory = True 
Exit Function 
End If 
Loop 
End Function 


Debug.Print IsDirectory("C:\Build\") 返 回 True。Debug.Print IsDirectory("C:\Build\Hello. 
csv") 返回 False。 


1.1.2 ”设置 文件 或 路 径 的 属性 
与 GetAttr 相对 应 的 函数 是 SetAttr， 该 函数 可 以 设置 文件 、 路 径 的 属性 
SetAttr "C:\Build\", vbHidden + vbReadonly 
这 条 代码 把 Build 文件 夹 的 属性 设置 为 只 读 ， 并 且 隐 藏 
SetAttr "C:\Build\", vbNormal 
这 人 句 代码 去 掉 只 读 和 隐藏 属性 ， 恢 复 为 正常 属性 。 
1.1.3 ”判断 文件 或 路 径 是 否 存在 
使 用 Dir 函数 可 以 列举 出 当前 路 径 下 所 有 文件 和 子 文件 夹 的 名 称 ， 从 而 间接 地 判断 一 个 
文件 或 文件 夹 是 否 存 在 。 
Dir 函数 的 语法 为 : 
Dir(PathName,Attributes) 


PathName 是 一 个 用 来 描述 文件 、 路 径 的 字符 串 ， 可 以 使 用 *、? 通配符 。Attributes 可 
以 使 用 如 表 1-2 所 示 的 值 。 


表 1-2 Dir 函数 用 的 筛选 常量 


(默认 ) 指定 没有 属性 的 文件 
指定 无 属性 的 只 读 文件 
指定 无 属性 的 隐藏 文件 
指定 无 属性 的 系统 文件 
指定 卷 标 文件 ， 如 果 指 定 了 其 他 属性 ， 则 忽略 vbVolume 
指定 无 属性 文件 及 其 路 径 和 文件 夹 


vbNormal 
vbReadOnly 
vbHidden 


VbSystem 


vbVolume 


vbDirectory 


第 1 章 文件 和 和 路径 操作 全 


如 果 不 规定 Attributes 属性 ， 则 默认 为 vbNormal。 
Sub 判断 文件 或 路 径 是 否 存 在 () 


Path = "C:\temp\Test.txt" 
IE Dir(Path) = "" Then 
Debug.Print Path & "不 存在 " 
Else 
Debug.Print Path & "确实 在 计算 机 中 。" 
End If 
End Sub 


代码 分 析 : 如 果 计 算 机 中 不 存在 Testtxt 这 个 文件 ， 那 么 Dir 函数 会 返回 空 字符 串 ; 如 果 文 
件 存在 ， 则 返回 第 一 个 符合 模式 的 文件 名 称 (不 包含 所 在 路 径 )， 据 此 可 以 判断 磁盘 或 文件 夹 中 
是 否 有 某 个 文件 。 此 外 ， 还 可 以 使 用 Dir 函数 判断 是 否 有 某 磁盘 分 区 ， 或 者 是 否 有 某 个 文件 夹 。 

如 果 上 述 过 程 中 的 Path 赋值 为 Path="M:" 或 者 Path="M:\"， 则 可 以 用 来 判断 是 否 存 在 
M: 盘 。 

如 果 要 判断 是 否 存在 某 文件 夹 (路径 )， 结 尾 必须 加 反 斜 杜 。 例 如 Dir("C:\build") 用 来 判 
断 C: 盘 下 是 否 有 build 这 个 文件 ， 而 Dir("C:\build\") 用 来 判断 C 盘 下 是 否 有 build 文件 夹 。 


1.1.4 ”遍历 文件 和 子 文件 夹 


利用 Dir 函数 和 不 带 参数 的 Dir， 可 以 遍历 一 个 路 径 下 的 所 有 文件 和 子 文件 夹 的 名 称 。 
现在 假定 C:\CTEX 文件 夹 中 的 内 容 如 图 1-2 所 示 。 


EE 3 六 Uninstallaxe 


图 1-2 文件 夹 中 的 内 容 
可 以 看 到 有 7 个子 文件 来，4 个 文件 。 运行 如 下 的 过 程 ， 打 印 出 所 有 的 子 文件 夹 名 称 和 
文件 名 称 。 
Sub 遍历 文件 和 子 文件 夹 () 


Dim parent As String, Path As String 
parent = "C:\CTEX\" 
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Path = Dir (Parent，VbDirectory) 
Debug.Print Path 
Do Until Path = "" 


Path = Dir Changes. txt 


Debug.Print Path CTeX _ 
i Ghostscript 
p GSview 
End Sub Logs 
、 二 MiKTeX 
上 述 程序 的 打印 结果 如 图 1-3 所 示 。 Readme. txt 


Repair. exe 
Uninstall. exe 
UserData 
WinEdt 


可 以 看 出 ， 第 一 行 打印 出 一 个 小 数 点 ， 第 二 行 打印 出 两 个 
小 数 点 ， 从 第 三 行 起 才 是 正式 的 内 容 。 

如 果 把 代码 中 的 Path = Dir(parent, vbDirectory) 修改 为 
Path = Dirparenb， 则 只 遍历 文件 ， 不 遍历 子 文件 来 。 3 

那么 如 何 只 遍历 子 文件 夹 呢 ?这 就 需要 在 循环 体 中 加 入 下 语句 来 选择 性 地 遍历 。 


Sub 遍历 子 文件 夹 () 
Dim parent As String, Path As String 
Dim Col Rs New Collection, v As Variant 
parent = "C:\CTEX\" 
Path = Dir(parent, vbDirectory) 
Col.Add Path 
Do Until Path = "" 
Path = Dir 
Col.Add Path 
Loop 
For Each v In Col 
If GetAttr(parent & V) And vbDirectory Then 


en 
Else 
Debug.Print Vv 
End If 
End If 
Next Vv 
End Sub 
上 述 过 程 中 ， 用 集合 Col 来 装载 所 有 的 文件 和 子 文件 夹 
的 名 称 ， 最 后 ， 遍 历 Col 的 时 候 ， 首 先 过 滤 出 所 有 的 子 文 件 CE 
夹 ， 然 后 排除 小 数 点 ,最 后 输出 纯粹 的 子 文件 夹 ， 共 7 个 ， Le 
如 图 1-4 所 示 。 MiKTeX 
UserData 
如 果 要 遍历 C:\Ctex 下 面 的 所 有 扩展 名 为 .txt 的 文本 文 WinEdt 


件 ， 代 码 可 以 修改 为 如 下 形式 。 
Sub 遍历 文本 文件 () 


Dim parent As String, Path As String 
parent = "C:\CTEX\" 
Path = Dir (Parent & "*.txt") 
Debug.Print Path 
Do Until Path = "" 

Path = Dir 


1-4 只 列举 子 文件 夹 名称 
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Debug.Print Path 


Loop 可 
as 1 
加 Readme. txt 
注意 ，Dir 函数 中 用 到 了 通配符 ，*.txt 可 以 匹配 所 有 的 文本 文 
件 ， 如 图 1-5 所 示 。 图 1-5 只 遍历 文本 文件 


1.1.5 “文件 的 复制 、 移 动 和 删除 


文件 的 复制 、 移 动 和 删除 操作 ， 分 别 用 FileCopy、Name As 和 Kill 语句 。 
FileCopy 的 语法 为 : 


FileCopy Source, Destination 


Source 表示 原文 件 ，Destination 表示 复制 的 目标 。 

例 如 FileCopy Source:="C:\temp\a.xlsx", Destination:="D:\dist\goal.xlsx*"， 表 示 把 文件 
Ci\temp\a.xls 复制 到 Di\dist 文件 夹 下 ， 并 日 重 命名 为 goal.xlsx。 

文件 的 移动 操作 就 是 文件 的 剪 切 ， 也 可 以 理解 为 文件 的 重 命名 。 与 复制 文件 的 区 别 是 ， 
原文 件 不 在 原 位 置 了 。 

Name "Ci:\temp\a.xlsx" As "D:\dist\b.xlsx"， 就 相当 于 把 a 文件 从 原 位 置 剪 切 到 Di\dist 文 
件 夹 中 ， 并 日 设置 名 称 为 b.xlsx。 


注意 针对 文件 的 移动 操作 ， 如 果 D:\dist\ 下面 原先 就 有 一 个 b.xlsx 文件 ， 那 么 运行 
上 述 的 Name 语句 会 导致 出 错 。 也 就 是 说 ， 必 须 保证 目标 文件 夹 中 还 没有 这 个 文件 ， 才 能 
进行 移动 操作 。 


Kill 语句 用 于 删除 文件 ， 如 果 文 件 处 于 打开 、 占 用 状态 ， 和 运行 该 语句 会 出 错 。 另 外 ,用 
Kill 语句 删除 掉 的 文件 ， 不 能 通过 回收 站 还 原 ， 要 谨慎 操作 。 
图 1-6 所 示 的 代码 连续 两 次 删除 同一 个 文件 ， 第 一 名 不 会 出 错 ， 但 是 运行 到 第 二 句 时 弹 
出 “文件 未 找到 ”的 错误 。 
Sub 删除 文件 () 
Kill "D:\dist\b. xlsx” 


Kill “D:\dist\b. xlsx 
End Sub 


图 1-6 重复 删除 同一 文件 的 错误 
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1.1.6 ”文件 夹 的 创建 和 删除 


文件 夹 的 创建 和 删除 分 别 用 MkDir 和 RmDir 语 句 ，Mk 是 Make 的 缩写 ，Rm 是 Remove 
的 缩写 。 

MkDir 语句 的 语法 很 简单 。 

MkDir Path:="C:\temp\2017"， 会 在 temp 文件 夹 下 创建 一 个 名 为 2017 的 文件 夹 。 

RmDir 语句 用 来 删除 一 个 空 文件 夹 。 

RmDir Path:="Ci\temp\picture"， 表 示 删 除 picture 文件 夹 ， 如 果 该 文件 夹 不 是 空 的 ， 包 含 其 
他 的 文件 和 子 文件 夹 ， 那 么 RmDir 会 提示 错误 ， Wao Veual533 昌 于 
如 图 1-7 所 示 。 Wf TS 

路 径 /文件 访问 湛江 

也 就 是 说 ， 要 删除 一 个 文件 夹 ， 必 须 先 把 里 
面 的 内 容 清空 后 ， 才 能 使 用 RmDir 语句 删除 。 

文件 夹 的 重 命名 也 使 用 Name…As 语句。 例 
如 Name "Ci\temp\picture" As "C:\temp\pic"， 表 示 
把 文件 夹 picture 重 命名 为 pic。 


1.1.7 “文本 文件 的 读 写 


编程 过 程 中 ， 经 常 需要 把 程序 运行 的 结果 数据 保存 到 文本 文件 ， 也 需要 从 文本 文件 中 读 
取 数 据 供 程序 使 用 ， 这 就 涉及 文本 文件 的 读 写 操作 了 。 

本 节 介 绍 一 下 用 于 文件 读 写 的 Open 语句 。 

Open 语句 的 语法 如 下 。 


绰 纺 C5) | 结束 中) 帮助 00) 
图 1-7 文件 夹 中 有 内 容 则 不 能 删除 


Open textFile For mode As fileNum 


参数 textFile 是 一 个 表示 文本 文件 路 径 的 字符 串 。 

参数 mode 表示 Open 语句 的 读 写 模式 ， 使 用 最 多 的 模式 如 下 。 

口 Append: 追加 模式 。 

口 Output: 擦 写 模式 。 

口 Input: 读 取 模式 。 

如 果 要 把 程序 运行 的 结果 输出 到 文本 文件 中 ,那么 使 用 Append 模式 会 把 输出 结果 
追加 到 文件 已 有 内 容 之 后 ， 而 使 用 Output 模式 ， 则 会 先 清空 文件 原先 的 内 容 ， 再 写 入 输 
出 结果 。 

如 果 要 从 文本 文件 中 读 取 内 容 ， 而 不 破坏 文件 ， 可 以 使 用 Input 模式 。 

要 注意 的 是 ， 在 使 用 Output 或 Append 模式 时 ， 如 果 计 算 机 中 textFile 文件 不 存在 ， 则 
会 自动 创建 一 个 文本 文件 ; 如果 使 用 Input 模式 读 取 一 个 文本 文件 ,文本 文件 不 存在 会 导致 
出 错 。 

参数 fileNum 是 一 个 文件 号 ,可 以 是 要 到 兹 11 中 的 任何 一 个 。 读 写 文件 操作 结束 后 ， 
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一 定 要 用 Close fileNum 关闭 文件 。 
下 面 讲述 一 下 导出 数据 到 文本 文件 中 的 方法 。 


Sub 导出 数据 () 
Open "C:\temp\abc.txt" For Output As #1 
Print #1, "hello VBA" 
Print #1, "you are welcome" 
Print #1，"2017 年 11 月 25 日 " & vbNewLine & " 刘 永 富 " 
Close #1 
End Sub 


上 述 过 程 把 三 个 字符 串 写 入 文本 文件 中 ,使 用 Print 语句 写 信 时， 在 末尾 自动 换行 ， 


图 1-8 所 示 。 
使 用 Print 在 同一 行 输出 多 个 字符 串 时 ， 每 个 字符 串 之 问 用 半角 分 号 隔 开 。 


Sub 导出 数据 () 
Open "C:\temp\abc.txt" For Output Rs #1 
Print #1, "hello VBA"; "you are great" 
Print #1, "you are welcome"; "ryueifu" 
Print #1，"2017 年 11 月 25 日 "; " 刘 永 富 " 
Close #1 
End Sub 


上 述 程序 的 运行 结果 如 图 1-9 所 示 。 


Dabctet -i 2 
文件 (月 ” 坊 强 (E) 格式 (D) 查看 (V) 帮助 (H) 
helle vBA i 
中 you are welcome 文件 (D。 编 句 (5) 格式 (O) 查看 (V) 帮助 (H) 
加 到 生生 2 hello VBAyou are great 
you are Welcomeryueifu 
2017 年 11 月 25 日 刘 永 富 
图 1-8 向 文件 写 人 内 容 图 1-9 同一 行 输出 多 个 结果 
除了 使 用 Print 语句 输出 外 ,还 可 以 使 用 Write 语句 输出 内 容 到 文本 文件 。 


Sub 导出 数据 2 () 
Open "C:\temp\abc.txt" For Output As #1 


如 


Write #1, "hello VBA" abcbt - 记事 本 


Write #1, "you are welcome" 


ee . 
文件 (月 ”编辑 (E) 格式 (O) 查看 (V) 帮助 (H) 


Write #1，"2017 年 11 月 25 日 " “hello VBA” 


Close #1 “you are welcome” 
End Sub 中 ”2017 年 11 月 25 日 “ 
程序 的 运行 结果 如 图 1-10 所 示 。 图 1-10 使 用 Wiite 输出 内 容 


可 以 看 出 文本 文件 中 的 内 容 都 带 有 双 引 号 ， 这 和 Print 语句 有 很 大 不 同 。 


如 果 把 Open "Ci\temp\abc.txt" For Output As #1 这 句 中 的 Output 换 成 Append， 则 每 次 


写 人 文件 时 ， 不 删除 文件 原 有 内 容 。 请 读者 自行 测试 。 
接 下 来 讲述 如 何 从 已 有 文本 文件 中 读 取 内 容 ， 供 程序 调用 。 
读 人 文件 内 容 涉及 的 常用 术语 有 : 
口 *=Imnput(cfileNum)， 表 示 从 文件 当前 位 置 读 取 c 个 字符 ， 赋 给 字符 串 变 量 v。 
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口 Seek fileNum, c， 把 当前 位 置 重 设 为 c,c 的 最 小 值 是 1。 
口 LOF(fileNum)， 返 回 文件 的 长 度 ， 也 就 是 文件 中 字符 总 数 。 
口 EOF(fileNum)， 返 回 一 个 布尔 值 ， 当 读 取 到 文件 尾部 ， 返 回 True。 经 常 使 用 EOF 来 


判断 是 否 读 取 完成 。 
现在 假设 文本 文件 auto.txt 中 的 内 容 如 图 1-11 所 示 。 Teo 
EECIE EECOEE VE 
Sub 导入 数据 () Nol eons Teor om le40693! 
I 


Open "C:\temp\auto.txt" For Input As #1 
MsgBox "文件 字符 总 数 : " & LOF (1) 图 1-11 文本 文件 内 容 
a = Input(1, #1) 
b = Input (2, #1) 
c= Input(3, #1) 


Seek #1, 1 
d = Input(3, #1) 
Close #1 
Debug.Print a, b, c,d 
End Sub 


代码 分 析 : a= Input(1, 拉 )， 表 示 从 文件 的 开头 处 读 取 1 个 字符 ， 赋 给 a， 因 此 变量 a 的 
取 值 为 字符 串 h。 

b = Input(2, #1)， 表 示 从 上 次 读 取 的 位 置 起 ， 读 入 2 个 字符 赋 给 变量 b， 因 此 b 的 取 值 
为 el。 以 此 类 推 。 

Seek #1, 1 表示 把 读 取 位 置 重 设 为 1， 也 就 是 文件 开头 ， 接 下 来 d = Input(3, # 提 ) 表示 从 
文件 开头 处 读 取 3 个 字符 ， 因 此 d 的 取 值 为 Hel。 

上 述 程序 的 运行 结果 如 图 1-12 所 示 。 


W el com Wel 


图 1-12 ”从 文件 中 读 取 字 符 
根据 这 个 特点 ， 可 以 把 文本 文件 中 的 所 有 字符 分 发 到 字符 串 数组 中 。 


Sub 文本 文件 转 数组 () 
Dim s() Rs String 
Dim i As Long 
Open "C:\temp\auto.txt" For Input Rs #1 
ReDim s(1 To LOF(1)) As String 
For i= 1 To LOF(1) 
s(i) = Input (1, #1) 
Next i 
Close #1 
Stop 
Debug.Print Join(s, "*") 
End sub 


代码 分 析 : 上 述 过程 ， 打 开 文 本 文件 后 ,根据 文件 字符 总 数 重新 定义 数组 的 上 下 界 ， 使 
得 数组 能 恰好 容纳 文本 中 的 字符 ， 然 后 使 用 For 循环 ， 遍 历 文本 文件 中 的 每 个 字符 ， 并 分 发 
到 数组 的 每 个 元 素 。 


第 1 章 文件 和 和 路径 操作 6 


运行 到 Stop 那 句 ， 通 过 本 地 窗口 可 以 清晰 地 看 到 数组 s 的 各 元 素 取 值 情况 ， 如 图 1-13 所 示 。 


妆 示 去 件 医 写 7 支 示 去 
String(l te 37) 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 
String 


Strine 


a 
ne 


Adanadddie 


FEE 


Ld 


图 1-13 本 地 窗口 查看 数组 
可 以 看 出 ， 每 个 元 素 恰好 取得 文件 中 的 一 个 字符 。 最 后 通过 Join 把 数组 用 * 重新 连接 
并 输出 ， 如 图 1-14 所 示 。 


We l comko*T*o*Q*Q*CFr XOFu*p*6*1*B*4k0*6*Q*3*1 
六 
玉 2 术 中 林 ] 玉 7 来/ 玉 ] 本] 六/ 术 2 本 5 


图 1-14 数组 连接 为 字符 串 


此 外 ,还 可 以 使 用 Line Input 语句 ， 每 次 读 取 一 整 行 。 
假设 文件 b.txt 中 有 4 行 古诗 ， 下 面 用 Line Input 读 取 内 容 。 
Sub 整 行 读 取 () 


Dim s As String 
Open "C:\temp\b.txt" For Input As #1 
Do Until EOF(1) 
Line Input #1, s 


Debug.Print s 
Loop 
Close #1 
End sub 


代码 分 析 : 本 例 直接 把 读 取 到 的 每 行 打 印 到 [二 


立 昌 循环 ， 汉 皇 重 色 思 倾 国 ， 御 字 多 年 求 不 得 。 
立即 窗口 因此 可 以 使 用 De 循环 利用 EOF 本 汉人 本 名 电 借 国 ， 生 字 多 年 求 不 得 
数 来 判断 是 否 读 到 文件 尾部 ， 如 果 到 了 尾部 ， 就 “|| 天 生 丽 质 难 自 弃 ， 一 朝 选 在 君王 侧 - 
tg 闸 蜂 一 笑 百 媚 生 ， 六 宫 粉 信 无 颜色 - 


上 述 程 序 的 运行 结果 如 图 1-15 所 示 。 图 1-15 使 用 Line Input 读 取 内 容 
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如 果 要 一 次 性 读 取 文本 文件 的 所 有 内 容 ， 可 以 使 用 下 面 的 自 定义 函数 。 


Public Function GetAllText (FileName As String) As String 
Open FileName For Binary As #1 
GetAllText = Input (LOF(1), #1) 
Close #1 
End Function 


运行 下 面 的 Test 过 程 ， 即 可 把 文件 中 的 所 有 内 容 打印 到 立即 窗口 。 


Sub Test() 
Debug.Print GetAllText ("C:\temp\new.txt") 
End Sub 


上 述 代码 的 源 文件 为 “实例 文档 01.xlsm”。 


1.2 二进制 方式 读 写 文件 


计算 机 中 的 文件 都 是 以 二 进 制 方式 存储 的 ， 文 本 文件 可 以 用 文本 编辑 软件 查看 和 编辑 ， 
本 质 上 也 是 以 字 节 为 单位 存储 在 磁盘 上 。 

因此 ， 学 习 用 二 进 制 方式 读 写 文件 ， 有 助 于 理解 文件 和 字符 串 的 关系 。 同 时 以 字 节 数组 
这 种 数据 类 型 为 媒介 ， 可 以 方便 地 对 文本 文件 进行 拆 分 和 合并 。 


1.2.1 字符 串 与 字 节 数 组 的 互 换 


在 VBA 中 ，String 和 Byte 类 型 的 数组 可 以 通过 StrConv 函数 互相 转换 ， 当 字符 串 中 的 
每 个 字符 是 英文 字母 或 半角 字符 时 ， 一 个 字符 占据 1 个 字 节 (Byte)， 当 出 现 中 文 汉字 或 全 角 
字符 时 ， 一 个 字符 会 拆 分 为 两 部 分 ， 也 就 是 占据 2 个 字 节 。 
下 面 的 代码 把 字符 串 “VBA 学 习 ” 转 换 为 字 节 数 组 ， 并 在 立即 窗口 打印 字 节 数组 的 信 
息 ， 最 后 再 把 字 节 数组 转换 为 字符 串 。 
Sub String2Byte() 
Dim s As String 
Dim b() As Byte 
b = VBA.StrConv ("VBA 学 习 ",， vbFromUnicode) 
Debug.Print UBound(b) - LBound(b) + 1 
Debug.Print b(0), b(1) 
s = VBA.StrConv(b, vbUnicode) 


Debug.Print s 
End Sub 


代码 分 析 : “ VBA 学 习 ” 共 5 个 字符 ,但 由 于 后 2 个 是 汉字 ， 所 以 转换 为 字 节 数组 后 ， 
数组 长 度 为 7， 分 别 从 b(0) 到 b(6)， 如 图 1-16 所 示 。 

| B [AT 学 习 | 

86 | 66 | 65 | 209 | 167 | 207 [ 176 | 

b(0) | b(1) | bC) | bG) | b(4) | b(5) | b(6) | 

图 1-16 字符 串 与 字 节 数组 的 关系 
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在 运行 上 述 代 码 过 程 中 ， 通 过 本 地 窗口 可 以 看 到 字 节 数组 b 的 构成 ， 如 图 1-17 所 示 。 


图 1-17 字 节 数组 的 构成 


上 述 过 程 运 行 完毕 后 ， 在 立即 窗口 打印 出 字 节 数组 的 长 ” 避 要 
T 


度 以 及 每 个 元 素 的 值 ， 并 且 把 字 节 数组 恢复 为 字符 串 ， 如 图 86 66 
1-18 所 示 。 VBA 学 习 
1.2.2 文本 文件 的 写 入 图 1-18， 运 行 续 果 


二 进 制 方式 打开 文件 的 语句 是 : 

Open Path For Binary Access Write As #1 

使 用 Put 语句 向 文件 中 写 入 内 容 。Put 语句 的 语法 格式 为 : 
Put #1,Pos,data 


其 中 , 让 是 文件 号 ，Pos 用 于 指定 文件 的 写 入 位 置 ， 如 果 不 指定 该 参数 ， 则 默认 在 文件 
结尾 处 写 入 。data 是 要 写 入 的 内 容 ， 可 以 是 字符 串 或 变量 ,也 可 以 是 字 节 数组 。 
下 面 的 程序 演示 了 二 进 制 方式 向 文件 中 先后 写 入 两 个 字符 串 。 


Sub WriteToFile() 
Dim sl As String, s2 Rs String 


Dim bl() As Byte, b2() Rs Byte 
sl = "VBA 程序" 
s2 = "设计 " 国 [ET 
bl = VBA.StrConv(sl, vbFromUnicode) 文件 类 型 。 “文本 文 悄 【 ct) 
b2 = VBA.StrConv(s2, vbFromUnicode) 打开 方式 国 记 本 
Open "C:\Temp\Examplel.txt" For Binary Access ee Re 
ENTE CTE) 
Wt ET | 
Put #1, , bl 
Bl 18 和 1 319 
Pat Sly D2 慷 汶 时 间 : 。 zole 年 5 月 1 日 ， 29:34:19 
Close #1 访 间 时间。 2018 年 2 月 1 日 ，20:34.19 
End Sub 属性 上 只 志 罗 。 回 驻 基 思 | 
上 述 代 码 执行 后 ， 记 事 本 中 的 内 容 为 “VBA 程序 设计 ”， | 
查看 该 文件 的 属性 ， 可 以 看 到 文件 大 小 为 11 字 节 。 因 为 “ 程 一 一 一 一 下 2 
序 设计 ”4 个 汉字 占据 8 字 节 ， 如 图 1-19 所 示 。 图 1-19 文件 的 大 小 


1.2.3 ”文本 文件 的 读 出 
二 进 制 方式 读 取 文件 的 语句 是 : 
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动 ; 


Open Path For Binary Access Read As #1 
使 用 Get 语句 从 文件 中 读 和 内容。Get 语句 的 语法 格式 为 : 
Get #1,Pos,Byte() 


其 中 ，Pos 参数 用 来 指定 读 取 位 置 ， 如 果 不 指定 ， 则 从 上 次 读 取 完毕 的 位 置 开始 读 。 
Byte() 是 用 来 存放 读 出 的 数据 的 字 节 数组 。 

在 读 取 的 过 程 中 ， 有 两 点 需要 注意 : 一 是 使 用 Get 读 取 过 程 中 ， 读 取 位 置 也 随 之 向 后 移 
二 是 声明 的 字 节 数组 的 大 小 决定 读 出 内 容 的 多 少 。 

假设 一 个 文本 文件 中 的 内 容 是 “ VBA 程序 设计 "， 共 7 个 字符 11 个 字 节 。 下 面 的 过 程 


分 两 次 读 取 其 中 的 内 容 。 


Sub ReadFile() 


Dim sl As String, s2 As String 
Dim bl() Rs Byte, b2() As Byte 
ReDim bl(0 To 4) 
ReDim b2(5 To 10) 
Open "C:\Temp\Examplel.txt" For Binary Access Read Rs #1 
Get #1; » bl 
Get #1, » b2 
Close #1 
sl = VBA.StrConv (bl, vbUnicode) 
5s2 = VBA.StrConv(b2, vbUnicode) 
Debug.Print sl, s2 


End Sub 


代码 分 析 : 上 述 代码 中 预先 指定 了 字 节 数组 bl 可 以 存放 5 个 字 节 ，b2 可 以 存放 6 个 字 
节 。 因 此 ， 当 执行 Get 机 , ,bl 这 名 时，bl 将 获取 文件 中 的 前 5 个 字 节 ， 也 就 是 ”VBA 程 ”， 


b2 接着 获取 其 后 的 剩余 部 分 。 


运行 上 述 代 码 ， 立 即 窗口 打印 出 字符 串 sl 和 s2， 如 图 1-20 所 示 。 

以 上 分 批 次 读 取 一 个 文件 的 原理 ， 是 实现 拆 分 文 
件 的 理论 基础 。 

在 实际 编程 过 程 中 ， 经 常 把 文件 的 所 有 内 容 读 取 
到 一 个 字符 串 变 量 中 ， 因 此 改写 为 如 下 过 程 。 


Sub ReadFile2() 


立 区 窗口 
VBA 程 序 设计 


图 1-20 字 节 数组 转换 为 字符 串 


Dim sl As String 
Dim bl() As Byte 
Open "C:\Temp\Examplel.txt" For Binary Access Read As #1 
ReDim bl(0 To LOF(1) - 1) ' 或 者 ReDim bl(0 To FileLen("C:\Temp\Examplel. 


tC 二 和 


Get #1, , bl 
Close #1 
sl = VBA.StrConv (bl, vbUnicode) 
Debug.Print sl 


End sub 


代码 分 析 : 要 把 文件 所 有 内 容 获 取 到 字 节 数组 中 ， 需 要 事先 知道 文件 的 长 度 ， 也 就 是 文 
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件 的 字 节 数 ， 可 以 用 FileLen 直接 获取 文件 长 度 ， 也 可 以 打开 文件 后 用 LOF 函数 获取 。 知 道 
了 文件 的 长 度 ， 就 可 重新 定义 数组 的 上 下 界 。 
运行 上 述 代码 ， 立 即 窗口 将 打印 出 文件 中 的 所 有 内 容 。 


1.2.4 ”文本 文件 的 拆 分 


如 果 文 本 文件 中 的 内 容 很 多 ， 不 方便 操作 时 ， 就 需要 拆 分 为 若干 个 小 文件 ， 具 体 拆 分 为 
多 少 个 小 文件 、 从 什么 位 置 开 始 拆 分 ， 这 些 基准 可 以 根据 实际 情况 而 定 。 
假设 “静夜 思 .txt” 文 本 文件 里 面 存放 的 内 容 如 图 1-21 所 示 。 


文件 (F) 编 纺 (E) 想 式 (O) 查看 (V) 二 助 (H) 


床 前 明月 光 ， 疑 是 地 上 霜 。 举 头 望 明月 ， 低 头 思 故 乡 。 


图 1-21 文件 内 容 


可 以 看 到 ， 里 面 每 一 句 都 是 5 个 汉字 再 加 1 个 中 文 标点 ， 也 就 是 说 每 句 占据 12 个 字 
节 ， 整 个 文件 48 字 节 。 现 在 要 求 把 这 个 文件 拆 分 为 4 份 ， 每 个 小 文件 保存 一 句 ， 命 名 为 
了 Part#.txt。 


Sub SplitFile() 
Dim b(0 To 11) As Byte 
Dim i As Integer 
Open "C:\Temp\ 静夜 思 .txt" For Binary Access Read As #1 
For i=1 To 4 
Get #1 为 
Debug.Print VBA.SsStrConv(b, vbUnicode) 
Open "C:\Temp\Part" & i & ".txt" For Binary Access Write As #2 
他 证 攻 者 世 革 
Close #2 
Next i 
Close #1 
End Sub 


代码 分 析 : 由 于 每 句 占据 12 字 节 ， 所 以 字 节 数组 要 规定 为 b(0 To 11) As Byte， 使 得 每 
次 恰好 读 出 12 字 节 。 

然后 在 循环 体 中 依次 读 取 每 一 行 ， 并 且 把 每 次 产生 的 字 节 数组 保存 到 不 同 的 子 文件 中 。 

上 述 过 程 运行 后 ， 可 以 看 到 文件 夹 中 多 了 4 个 子 文 件 ， 如 图 1-22 所 示 。 


昌 T 莹 目 parlbt 文本 文档 2018/2/11 21:32 1KB 
到 点 丁 目 par2bd 文本 文档 2018/2/11 21:32 1KB 
是 最 5 访问 的 位 置 目 par3bt 文本 文档 2018/2/11 21:32 1KB 
OneDrive 目 panaad 文本 文档 2018/2/11 21:32 1KB 

| 巷 夜 县-bd 六 2018/2/11 21:27 1KB| 


1-22 文件 的 拆 分 结果 
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1.2.5 ”文本 文件 的 合并 


平时 可 能 会 遇 到 将 很 多 格式 比较 相似 的 记事 本 文件 汇总 到 同一 个 文件 中 的 情况 。 文 件 合 
过 程 与 拆 分 过 程 恰好 相反 ,不 同 的 是 文件 合并 过 程 中 ， 要 多 次 读 取 每 个 子 文件 ， 然 后 写 人 
总 文件 中 。 

下 面 的 实例 在 打开 总 体 文件 的 前 提 下 依次 打开 每 个 子 文件 ， 读 取 内 容 到 数组 ， 然 后 立即 
写 人 总 文件 。 


Sub MergeFile() 
Dim b(0 To 11) As Byte 
Dim i As Integer 
Open "C:\Temp\Merged.txt" For Binary Access Write As #1 
For i=1To4 
Open "C:\Temp\Part" & i & ".txt" For Binary Access Read As #2 
Get #2, , b 
Put #1 7 入 
Close #2 
Next i 
Close #1 
End Sub 


代码 分 析 : 总 文件 的 文件 号 是 电 ， 子 文件 的 文件 号 是 志 。 
运行 上 述 代码 ， 计 算 机 中 产生 一 个 名 为 Merged.txt 的 新 文件 ， 该 文件 内 容 是 一 首 完整 的 
“静夜 思 ”。 


1.2.6 ”二 进 制 文件 的 复制 


除了 处 理 文本 文件 外 ， 还 可 以 使 用 二 进 制 方式 读 写 计算 机 中 的 各 种 类 型 的 文件 ， 假 设 读 
取 文 件 和 到 字 节 数组 B 中 ， 再 把 字 节 数组 B 写 入 文件 Y 中 ,这样 就 实现 了 文件 的 复制 。 
下 面 的 过 程 把 PythonLogo.png 这 个 图 片 读 出 到 数组 ， 然 后 把 数组 写 人 New.png。 


Sub CopyFile() 
Dim b() As Byte 
Open "C:\Temp\PythonLogo.png" For Binary Access Read As #1 
ReDim b(0 To LOF(1) - 1) 
Get #1, , b 
Close #1 
Open "C:\Temp\New.png" For Binary Access Write As #2 
Put #2, , b 
Close #2 
End Sub 


运行 上 述 过 程 后 ， 将 在 磁盘 中 多 了 一 个 New.png 图 片 ， 这 个 图 片 文 件 与 原始 图 片 文件 
完全 相同 。 
上 述 代码 的 源 文件 为 “实例 文档 01b.xlsm”。 


1.3 使 用 文件 系统 对 象 


FSO (FileSystemObject) 不 仅 可 以 像 使 用 传统 文件 操作 语句 那样 实现 文件 的 创建 、 改 变 、 
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移动 和 删除 ， 而 且 可 以 检测 是 否 存 在 指定 的 文件 夹 ， 如 果 存 在 ， 那 么 这 个 文件 夹 又 位 于 磁盘 
上 的 什么 位 置 。 更 令 人 高 兴 的 是 ，FSO 对 象 模型 还 可 以 获取 关于 文件 和 文件 夹 的 信息 ， 如 名 
称 、 创 建 日 期 或 修改 日 期 等 以 及 系统 中 使 用 的 驱动 器 的 信息 ， 如 驱动 器 的 种 类 是 CD-ROM 
还 是 可 移动 磁盘 ， 当 前 磁盘 的 剩余 空间 还 有 多 少 。 

FSO 对 象 本 身 不 属于 VBA 对 象 ， 要 在 VBA 中 使 用 FSO 操作 文件 和 路 径 ， 可 以 用 前 期 
绑 定 ， 也 可 以 用 后 期 绑 定 。 


1.3.1 前 期 绑 定 


Office VBA 不 仅 可 以 使 用 VBA 本 身 的 对 象 、 成 员 ， 而 且 可 以 引入 外 部 对 象 ， 例 如 在 
VBA 中 使 用 FSO、 字 典 、 正 则 表达 式 ， 以 及 后 面 讲 到 的 操作 其 他 Office 组 件 ， 其 实 都 是 在 
VBA 工程 中 引入 了 外 部 对 象 。 

所 谓 的 前 期 绑 定 ， 就 是 在 编写 程序 之 前 ， 把 外 部 对 象 库 加 入 工程 的 引用 ( References) 
中 。 这 样 做 的 好 处 是 ,在 写 代码 的 时 候 ， 这 些 相关 的 对 象 后 面 输入 小 数 点 ， 可 以 自动 列 出 成 
员 ， 而 且 在 声明 变量 时 ， 也 可 以 直接 指定 变量 的 类 型 。 

采用 前 期 绑 定 方式 ， 可 以 使 用 New 关键 字 或 GetObject 函数 创建 一 个 新 的 对 象 。 

下 面 介 绍 一 下 采用 前 期 绑 定 方式 ， 向 VBA 工程 引入 FSO 对 象 的 步骤 。 

单 击 VBA 编辑 器 的 菜单 【工具 /1 引 用】， 弹 出 工程 的 引用 对 话 框 。 在 对 话 框 中 勾 选 
“Microsoft Scripting Runtime”， 单 击 “ 确 定 ” 按 钮 关闭 对 话 框 ， 如 图 1-23 所 示 。 


引用 - VBAProject 
可 使 用 的 引用 A): 
JNMicrosoft PenInputPanel 1.7 消 
Microsoft PowerPoint 15.0 Object L: ~ | 


DMicrosoft Remote Data Services 6.0 


DMicrosoft Remote Data Services Ser' 浏览 B)... 


DMicrosoft Repository 
DMicrosoft Repository Add-In Type L 全 
1 ontro 0 


Isra I 
li crosoft 优先 级 
i er dbrery 帮助 00 
DMicrosoft SharePoint Plug-in for F: 二 

DMicrosoft Shell Controls And Auton 

DMicrosoft Sidebar API Type Library 

DMicrosoft SourceSafe 6.0 Type Libr 

[Wi era + Smnaarh nihiarf Tihvarm 

4 咱 上 


ipting Runtime 


Mi erosoft Scripting Runtime 


定位 : 。 C:\Windows\systen32\scrrun dll 


语言 : 标准 


图 1-23 添加 外 部 引用 


“Microsoft Scripting Runtime ”这 个 外 部 引用 位 于 路 径 “ C:\Windows\System32\scrrun. 
dl” 这 个 动态 链接 库 中 ， 每 个 Windows 系统 都 有 这 个 文件 。 

VBA 工程 一 旦 引入 了 这 个 外 部 引用 ， 就 可 以 使 用 FSO 对 象 模型 ， 以 及 后 面 要 讲 到 的 字 
典 (Dictionary) 对 象 。 

下 面 通 过 一 个 VBA 过 程 来 测试 一 下 。 
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Sub Test() 

Dim FSO As Scripting.FileSystemObject 

Set FSO = New Scripting.FileSystemObject 

FSO.CopyFile Source:="C:\dist\34.txt", Destination:="C:\dist\35.txt" 
End Sub 


当 输 入 Scripting 后 面 的 小 数 点 时 ,会 自动 弹出 FSO 相关 的 成 员 ， 这 就 是 前 期 绑 定 的 特 
点 。 运 行 上 述 过 程 ， 会 执行 复制 文件 操作 。 


1.3.2 ”后 期 绑 定 


后 期 绑 定 ， 就 是 程序 中 用 到 的 外 部 对 象 ， 不 往 工 程 中 添加 引用 ， 而 是 在 需要 该 外 部 对 
象 的 地 方 ， 使 用 CreateObject 函数 来 创建 对 象 。 针 对 后 期 绑 定 ， 由 于 VBA 的 工程 没有 添 
加 对 象 库 的 引用 ， 自 然 就 不 会 自动 列 出 成 员 ， 声 明 这 方面 的 变量 时 ， 只 能 声明 为 Object 或 
Variant 类 型 。 

下 面 新 建 一 个 工作 短 ， 打 开 VBA 编辑 器 在 标准 模块 中 直接 书写 一 个 过 程 。 


Sub LateBound() 
Dim FSO Rs Object 
Set FSO = CreateObject ("Scripting.FileSystemObject") 
FSO.MoveFile "C:\dist\34.txt", "C:\temp\36.txt" 

End Sub 


书写 上 述 代码 时 的 感受 就 是 不 弹出 成 员 ， 也 没有 任何 语法 提示 。 但 是 上 述 过 程 可 以 正常 
执行 ,实现 文件 的 移动 或 重 命名 。 

在 实际 编程 过 程 中 ， 前 期 绑 定 和 后 期 绑 定 的 代码 通过 改写 ， 就 可 以 转换 ， 但 是 对 于 刚刚 
学 习 一 个 新 对 象 库 ， 推 荐 使 用 前 期 绑 定 方式 。 因 为 使 用 这 种 方式 可 以 快速 了 解 新 对 象 的 模型 
结构 和 语法 特征 。 


1.3.3 ”FSO 对 象 模型 


FSO 对 象 主要 包括 : Drive (分 区 、 磁 盘 驱 动 器 )、Folder (文件 来、 路 径 )、File (文件 )、 
TextStream (文本 文件 )， 以 及 FileSystemObject 这 五 类 对 象 。 


1.3.4 ”遍历 磁盘 分 区 


FSO 对 象 模型 中 的 Drive 对 象 可 以 表达 一 个 分 区 。FSO.Drives 是 一 个 集合 对 象 ， 用 来 返 
回 所 有 分 区 。 

下 面 的 过 程 遍历 计算 机 的 所 有 分 区 的 名 称 、 总 大 小 、 可 用 空间 、 已 用 空间 。 其 中 已 用 空 
间 是 用 总 大 小 减 去 可 用 空间 得 到 的 。 

Sub 遍历 磁盘 分 区 () 


On Error Resume Next 
Dim fso As New Scripting.FileSystemObject 
Dim drv As Scripting.Drive 
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MsgBox "分 区 总 数 : " & fso.Drives.Count 
Debug.Print "分 区 : ",， "总 大 小 "， "可 用 空间 "，" 已 用 空间 " 
For Each drv In fso.Drives 
With drv 
Debug.Print .Path, .TotalSize, .FreeSpace, .TotalSize - .FreeSpace ' 单位 : 字 节 
End With 
Next drv 
End Sub 


运行 上 述 过 程 ， 立 即 窗 口 的 结果 如 图 1-24 所 示 。 
在 计算 机 的 资源 管理 器 中 查看 E: 盘 的 属性 ， 可 以 看 到 EE: 盘 的 总 大 小 和 可 用 空间 与 
VBA 运行 结果 是 一 致 的 ， 如 图 1-25 所 示 。 


己 用 空间 


总 大 小 可 用 空间 间 

64428584960 。 59975622656 4452962304 
120030461952 48152723456 71877738496 
185691549696 16579067904 169112481792 
269576302592 221673009152 47903293440 A 
230455861248 56259457024 174196404224 


固 压 第 上 8E 动 器 以 忆 约 沽 盘 空 间 ) 


ED GE) LR 


图 1-24 遍历 磁盘 分 区 图 1-25 ”核对 磁盘 分 区 大 小 
如 果 分 区 大 小 改写 为 更 大 容量 单位 的 ， 首 先 要 了 解 如 下 换算 关系 。 
1GB=1024MB 
1MB=1024KB 


1KB=1024B，B 表示 字 节 
可 以 看 出 1GB=10243B 
下 面 的 过 程 单独 查看 E: 盘 的 总 大 小 和 可 用 空间 ， 用 GB 表示 。 


Sub 查看 分 区 () 
Dim e As Scripting.Drive 
Dim fso As New Scripting.FileSystemObject 
Set e = fso.Drives.Item("E:") 
Debug.Print "总 大 小 (GB) "，" 可 用 大 小 (GB) "，" 序列 号 " 
Debug.Print Int(e.TotalSize / 1024 ^ 3), Int(e.AvailableSpace / 1024 ^ 3), 
e.SerialNumber 
End Sub 


上 述 程 序 的 运行 结果 如 图 1-26 所 示 。 


总 大 小 (6B) ”可 用 大 小 (6B) 序列 号 
251 206 451934710 


1-26 查看 磁盘 分 区 属性 
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1.3.5 “操作 文件 来 


FSO 对 象 模型 的 Folder 对 象 表示 一 个 文件 夹 ， 或 者 称 为 一 个 路 径 。Folder 对 象 本 身 有 
大 量 的 属性 、 成 员 和 方法 可 以 使 用 。 
要 表达 一 个 文件 夹 ， 只 能 使 用 FSO.GetFolder(" 文件 夹 路 径 ") 的 方式 。 


下 面 的 过 程 查看 一 个 文件 夹 的 总 大 小 、 子 文件 夹 的 个 数 和 文件 的 个 数 。 
Sub 查看 文件 夹 () 

Dim fso As New Scripting.FileSystemObject 

Dim fd As Scripting.Folder 

Set fd = fso.GetFolder("C:\dist") 

With fd 

Debug.Print .Size, .SubFolders.Count, .Files.Count 

End With 

End Sub 


运行 结果 如 图 1-27 所 示 。 

在 资源 管理 器 中 查看 dist 文件 的 属性 ， 对 比 后 发 现 文件 夹 的 大 小 和 运行 结果 是 一 致 的 。 
但 是 , 文件 夹 和 文件 的 个 数 不 一 样 ， 这 是 因为 FSO 中 的 SubFolders 和 Files 是 文件 夹 直 属 的 
文件 夹 和 文件 ， 不 包括 子 文件 夹 以 及 子 文件 夹 中 的 文件 。 

资源 管理 器 中 看 到 的 则 是 该 文件 夹 中 包含 的 所 有 文件 夹 和 文件 (包括 递归 肉 套 的 子 文件 
夹 )， 如 图 1-28 所 示 。 


Ea 
dist 属性 Fy li 
梨 规 | 共享 [安全 | 以 前 的 版 本 | 自 定义 
上 Eon 
类 型 文件 来 
位 置 CS 
大 小 165 MB (173, 302, 736 字 节 ) 


占用 空间 : 。 165 WB (173, 480, 533 字 节 ) 
包含 74 个 文件 ，4 个 文件 夹 


创建 时 间 : 。 2017 年 5 月 6 日 ，19:21:23 


属性 国 只 读 ( 仅 应 用 于 文件 夫 中 的 文件 ) G) 


国史 藏 0 高 级 加) 


| 173302736 2 23 


[Eee EN] [ER 


图 1-27 查看 文件 夹 的 大 小 以 及 子 文件 夹 和 文件 的 数量 图 1-28 查看 文件 夹 属性 
下 面 的 过 程 列 出 了 文件 夹 Folder 对 象 的 其 他 常用 属性 。 
Sub 文件 夹 的 常用 属性 () 


Dim fso As New Scripting.FileSystemObject 
Dim fd As Scripting.Folder 

Set fd = fso.GetFolder("C:\temp\Demo") 
With fa 


Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 


End With 
End Sub 


mai 


行 上 述 程序 ， 
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Print " 文件 夹 属性 "， -REtributes 

Print "文件 夹 创建 日 期 "，.DateCreated 
Print "文件 夹 访问 日 期 "， .DateLastAccessed 
Print "文件 夹 修 改 日 期 "，.DateLastModified 
Print "文件 夹 所 属 分 区 "， .Drive 

Print " 是否 为 根 文件 夹 "， .IsRootFolder 
Print "文件 夹 名 称 "， .Name 

Print " 父 级 文件 夹 "， .ParentFolder.Name 
Print "文件 夹 路 径 "，.Path 

Print "文件 夹 短 名 称 "， .ShortName 

Print "文件 夹 短 路 径 "， .ShortPath 

Print "文件 均 大 小 "， .Size 

Print "文件 夹 类 型 "， .TYPe 


立即 窗口 的 结果 如 图 1-29 所 示 。 


文件 夹 属性 16 
文件 夹 创建 日 期 2017/6/19 19:21:16 
文件 夹 访问 日 期 2017/6/20 21:49:32 
文件 夹 修 改 日 期 2017/6/20 21:49:32 
文件 夹 所 属 分 区 C: 

是 否 为 根 文件 夹 False 

文件 夹 名 称 Demo 

父 级 文件 夹 temp 

文件 夹 路 径 C:\temp\Demo 
文件 夹 短 名 称 ”Demo 

文件 夹 短 路 径 。 C:\temp\Demo 

文件 夹 大 小 918455 

文件 夹 类 型 文件 夹 


图 1-29 文件 夹 的 有 关 属 性 


文件 夹 Folder 对 象 的 常用 方法 主要 有 Copy、Move 和 Delete 等 ， 用 于 复制 、 移 动 、 删 
除 文件 夹 。 下 面 的 过 程 首 先 创 建 一 个 空 文件 来， 然后 重 命名 文件 夹 ， 最 后 删除 该 文件 夹 。 


Sub 文件 夹 的 常用 方法 () 
Dim fso As New Scripting.FileSystemObject 
Dim fd As Scripting.Folder 


Set fd = fso.CreateFolder("C:\temp\2019") 


' 在 temp 下 创建 一 个 名 为 2019 的 文件 夹 


fd.Move Destination:="C:\temp\2020" ' 把 文件 夹 重 命名 为 2020 


fd.Delete Force:=True 


End Sub 


"Force 为 True 表示 可 以 删除 具有 只 读 属性 的 文件 夹 


需要 注意 的 是 ，FSO 对 象 模型 中 文件 夹 的 Copy、Move、Delete 方法 对 于 非 空 文件 
夹 同样 有 效 ， 也 就 是 说 ， 即 使 被 操作 的 文件 夹 包含 文件 和 子 文件 夹 ， 也 被 一 起 复制 、 移 


动 和 删除 。 


要 获取 和 返回 一 个 文件 夹 Folder 对 象 ， 除 了 上 面 介绍 过 的 GetFolder、CreateFolder 方法 
以 外 ， 还 可 以 使 用 Folder 对 象 的 SubFolders 、ParentFolder 得 到 文件 夹 的 子 文件 夹 和 父 级 文 


件 夹 。 
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1.3.6 ”文件 夹 拒绝 访问 的 问题 


磁盘 根 目 录 下 除了 包含 正常 的 文件 夹 外 ,经常 还 包含 一 些 隐 藏 的 系统 文件 来， 当 用 
FSO 读 写 这 些 系 统 文件 夹 时 ， 会 弹出 “拒绝 访问 ”的 错误 。 

如 果 计 算 机 的 文件 夹 选项 中 设置 了 不 显示 隐藏 的 文件 和 文件 夹 或 驱动 器 ， 那 么 在 资源 管 
理 器 中 看 到 的 全 是 可 以 正常 操作 的 文件 夹 ， 如 图 1-30 所 示 。 


| am -ss 中 -#4 || © 
国 视 顺 ls . 修改 日 其 类 型 | 
国 轩 | 上 holiday 2018/5/26 11:47 文件 夫 
国 逆 加 Lee 2017/3/2 20:29 。 ”文件 实 | 
中 二 和 Btemp 2018/5/14 1939 。 文件 夫 中 
国 installlog 2017/3/2 18:15 文本 文档 
网 RE 组 国 JetbrainsCrack-2.6.2jar 2017/4/28 1845 Executable Jar File 
@ pycharmexevmoptions 2017/4/28 18:45 。 VMOPTIONS 文件 
亲 计算 机 国 pycharm64.exevmoptions 2017/4/28 18:45 。 VMOPTIONS 文件 


图 1-30 不 显示 隐藏 的 文件 夹 


通过 更 改 “ 文 件 夹 选 项 ”， 切 换 到 “查看 ”选项 卡 ， 找 到 “隐藏 受 保护 的 操作 系统 文件 ， 
去 掉 勾 选 ， 并 且 选 择 “显示 隐藏 的 文件 、 文 件 夹 和 驱动 器 "， 如 图 1-31 所 示 。 


底 ae 一 = 
| 查看 “| 扫 案 a 
| 文件 来 视图 
可 
国 、 时 和 
| 应 用 到 文件 来 L) 重 置 文件 夹 | 
| 
高 级 设置 : 
辟 鼠标 指向 文件 来 和 点 面 项 时 显示 提示 信息 ^ 
可 显示 好 动 宕 总 _ 
局 用 彩色 显示 加 密 或 庄 编 的 FS 文件 
口 在 标题 栏 显 示 完 整 路 径 ( 公 限 经 典 主题 ) 
| 固 在 单 种 的 进程 中 打开 文件 夹 窗口 
充 立 件 出 本 于 小 百 二 立体 上 小 们 自 也 | 
| Er | 
确定 ][ 取 肖 | [应 用 内 


图 1-31 显示 隐藏 的 文件 、 文 件 夹 和 驱动 器 
设置 完毕 后 ，A: 盘 根 目录 下 看 到 了 隐藏 的 文件 夹 (图 标 比较 虚 )， 如 图 1-32 所 示 。 
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= 
类 型 


2017/3/6 1723 ”文件 突 
2017/3/24 19:21 ”文件 实 
2017/3/9 1948 文件 去 
2018/5/13 19:03 。 文件 突 
2018/5/26 11:47 。 文件 突 
2017/3/2 2029 文件 夫 


A System Volume Information 2017/3/2 1755 。。 文件 夫 
Btemp 2018/5/14 19:39 。 文件 赤 

Users 2017/3/21745 文件 夫 
目 installoe 2017/3/2 18:15 文本 文档 
国 JetbrainsCrack-262jar 2017/4/28 18:45 。 Executable Jar File 
3 pycharm.exe vmoptions 2017/4/28 1845 。 VMOPTIONS 文件 
加 pycharm64.exevmoptions 2017/4/28 18:45 VMOPTIONS 文件 


图 1-32 显示 文件 夹 中 隐藏 的 内 容 


这 些 隐藏 文件 夹 大 多 数 是 系统 文件 来， 因此 它们 的 属性 是 由 vbHiddent+ 
vbSystem+vbDirectory 组 合 的 ， 结 果 为 22。 正 常 文件 夹 的 结果 是 16。 

下 面 的 程序 遍历 A: 盘 根 目录 下 的 所 有 子 文件 夹 ， 如 果 不 是 隐藏 文件 夹 ， 就 打印 其 名 称 、 
包含 的 子 文件 夹 个 数 、 属 性 值 。 


Sub 处 理 文件 夹 拒绝 访问 () 
Dim FSO As New Scripting.FileSystemOobject 
Dim fd As Scripting.Folder 
For Each fd In FSO.GetEFolder("RA:") .SubFolders 
If (fd.Attributes And vbHidden) <> vbHidden Then 
Debug.Print fd.Name, fd.SubFolders.Count, fd.Attributes 
End If 
Next fd 
End Sub 


以 上 代码 中 ， 焉 判断 语句 起 到 过 滤 文 件 夹 的 作用 ， 不 处 理 隐藏 的 文件 夹 。 

运行 上 述 程 序 ， 立 即 窗口 的 打印 结果 如 图 1-33 所 示 。 

可 以 看 出 ， 只 有 3 个 文件 夹 是 正常 文件 夹 。 

假设 去 掉 上 述 代 码 中 的 下 判断 语句 ， 再 次 运行 上 述 程序 ， 当 遍历 到 “ System Volume 
Information ”这 个 文件 夹 ， 访 问 得 .SubFolders.Count 属性 时 ， 弹 出 如 图 1-34 所 示 运 行 时 错误 。 


holiday 0 16 
LenovoDrivers 1 16 
temp 6 16 帮助 0 


1-33 ”只 列举 正常 的 文件 夹 图 1-34 不 可 访问 系统 文件 夹 
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综 上 所 述 ， 在 处 理 文件 夹 时 ,需要 考虑 到 该 文件 夹 能 否 被 访问 ， 必 要 时 需要 补充 上 述 过 
滤 条 件 。 


1.3.7 ”操作 文件 


FSO 对 象 模型 中 的 File 对 象 表示 一 个 文件 。 与 Folder 对 象 类 似 ，File 对 象 也 有 很 多 的 
属性 和 方法 。 
在 下 面 的 过 程 中 ,用 GetFile 方法 获取 一 个 文件 后 ， 遍 历 该 文件 的 常用 属性 。 


Sub 文件 的 常用 属性 () 

Dim fso As New Scripting.FileSystemObJject 

Dim fl As Scripting.File 

Set fl = fso.GetFile("C:\temp\abc.xls") 

With fl 
Debug.Print "文件 属性 "，.Attributes 
Debug .Print "文件 创建 日 期 "， .DateCreated 
Debug.Print "文件 访问 日 期 "， .DateLastRccessed 
Debug.Print "文件 修改 日 期 "， .DateLastModified 
Debug.Print "文件 所 属 分 区 "， .Drive 
Debug.Print "文件 名 称 "， .Name 
Debug.Print " 父 级 "， .ParentFolder.Name 
Debug.Print "文件 路 径 "，.Path 
Debug .Print "文件 短 名 称 "， .ShortName 
Debug .Print "文件 短路 径 "， .ShortPath 
Debug.Print "文件 大 小 "， .Size 
Debug.Print "文件 类 型 "， .Type 


End With 
End Sub 
上 述 程 序 的 运行 结果 如 图 1-35 所 示 。 
二 | 
文件 属性 32 
文件 创建 日 期 ”2017/4/21 15:39:19 
文件 访问 日 期 ”2017/6/24 22:41:59 
文件 修改 日 期 ”2017/6/24 22:41:59 
文件 所 属 分 区 C: 
文件 名 称 abc. xls 
父 级 文件 temp 
文件 路 径 C:\temp\abc. xls 
文件 短 名 称 abc. xls 
文件 短路 径 C:\temp\abc. xls 
文件 大 小 247808 
文件 类 型 Microsoft Excel 97-2003 工作 表 


1-35 文件 的 属性 
文件 对 象 File 的 常用 方法 有 Copy、Move、Delete。 下 面 通过 一 段 代 码 进行 了 解 。 
Sub 文件 的 常用 方法 () 


Dim fso As New Scripting.FileSystemObject 

Dim fl As Scripting.File 

Set fl = fso.GetFile("C:\temp\abc.xls") 

fl.Copy Destination:="C:\dist\xyz.xls" " 复制 文件 


文件 夹 下 的 直属 文件 。 


Set fl = fso.GetFile("C:\dist\xyz.xls") 
fl.Delete 

Set fl = fso.GetFile("C:\temp\abc.xls") 
fl.Move Destination:="C:\temp\123.xls" 


End Sub 


代码 分 析 : 先 把 abc.xls 复制 到 dist 文件 夹 下 ， 并 修改 名 称 为 xyz.xls。 接 着 删除 xyz.xls， 
最 后 把 abc.xls 重 命 名 为 123.xls。 


1.3.8 遍历 文件 


Dim fso As New Scripting.FileSystemOobject 
Dim fd As Scripting.Folder, fl As Scripting.File 


Set fd = fso.GetFolder("C:\CTEX") 


Debug.Print "名 称 "，" 修改 日 期 "，" 类 型 "， 


For Each fl In fd.Files 


"大 小 " 
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' 删除 文件 
' 移动 或 重 命名 文件 


文件 夹 对 象 下 面 有 一 个 Files 集合 对 象 ， 表 示 该 文件 夹 下 的 所 有 文件 。 可 以 据 此 来 遍历 
该 方法 无 法 遍历 包含 在 子 文件 夹 中 的 文件 。 
下 面 的 程序 遍历 CTEX 文件 夹 下 的 所 有 文件 ， 并 且 打 印 每 个 文件 的 重要 属性 。 


Sub 遍历 所 有 文件 () 


Debug.Print fl.Name, fl.DateLastModified, fl.Type, fl.Size / 1024 & " KB" 


Next fl 


End Sub 


上 述 程序 的 运行 结果 如 图 1-36 所 示 。 


名 称 修改 日 期 类 型 

Changes. txt 2012/3/22 16:16:12 文本 文档 
Readme. txt 2012/3/22 12:50:36 文本 文档 
Repair.exe 2012/3/22 16:16:22 应 用 程序 
Uninstall. exe 2017/6/6 8:43:48 应 用 程序 


大 小 

11.33984375 KB 

3. 580078125 KB 
126. 3466796875 KB 
86. 2841796875 KB 


图 1-36 遍历 文件 夹 中 的 所 有 文件 
果 一 致 ， 如 图 1-37 所 示 。 


在 资源 管理 器 中 查看 文件 的 属性 ， 发 现 和 输出 结 


| 他 中 在 要 CTEX 


= 
GO Hin , ss » crex ， 
= = 


组织 ” 外 襄 到 寺中” 。 共享 ” 新 建文 人 4 夫 
轩 二 E59 的 0 羡 。 “和 次 CE] em 大 小 
ee rex 2017/616841 。。 文 # 夫 
点 shosscrpt 2017/616 841 。。 文 夫 
局 车 BSsview 2017/6/6 B42 文件 去 
国税 六 Log: 2017/6/6 842 文件 夫 
加 图片 于 MikTex 2017/616 838 六 
EE UserDats 2017/616 845 。。 文 伯 夫 
间 迅雷 下 过 下 winEdt 2017/616 1023 。 文 伯 夫 
由 目 chacgesbt 2012/3122 1646 。 文本 文档 12x8 
目 keadmeau 2012/3122 12.50 。 文 间 文档 4KB 
所 四 hepuiree 2012/3122 1646 。 证 FE 庄 127K8 
器 Uninstallexe 2017/6/6 843 应 下 且 序 87 KB 
覃 HH 
1 上 
了 个 
b 


图 1-37 核对 文件 属性 
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如 果 要 选择 性 地 遍历 文件 ， 例 如 只 遍历 文件 夹 中 的 文本 文件 ， 只 需要 在 For 循环 中 符 套 
于 语句， 判断 一 下 扩展 名 即 可 。 


Sub 遍历 文本 文件 () 
Dim fso As New Scripting.FileSystemObject 
Dim fd As Scripting.Folder, fl As Scripting.File 
Set fd = fso.GetFolder("C:\CTEX") 
For Each fl In fd.Files 


If fso.GetExtensionName (fl.Path) = "txt" Then 
Debug.Print fl.Path 
End If 
Next fl 
End Sub 
OD 
代码 分 析 : FSO 的 GetExtensionName 可 以 返回 指定 C:\CTEX\Changes. txt 
文件 的 扩展 名 C:\CTEX\Readme. txt 

上 述 程序 的 运行 结果 如 图 1-38 所 示 。 图 1-38 只 遍历 指定 扩展 名 的 文件 


需要 注意 的 是 : 在 用 For Each 循环 遍历 文件 夹 中 的 所 有 文件 时 ， 尽 量 不 要 在 遍历 的 同 
时 对 文件 进行 重 命名 、 删 除 、 复 制 、 移 动 等 操作 ， 以 免 发 生 不 可 预料 的 结果 。 比 较 安 全 的 做 
法 是 遍历 的 时 候 可 以 先 把 所 有 文件 名 存储 到 数组 或 字典 中 ， 后 期 对 数组 或 字典 进行 操作 。 


1.3.9 遍历 子 文 件 夹 


一 个 文件 夹 中 可 能 包含 多 个 子 文件 夹 ， 在 FSO 对象 模型 中 ，SubFolders 集合 对 象 表示 
磁盘 分 区 或 者 文件 夹 下 面 的 所 有 子 文件 夹 。 

下 面 的 代码 遍历 CTEX 文件 夹 下 的 所 有 子 文件 夹 ， 打 印 每 个 子 文件 夹 的 路 径 ， 以 及 子 
文件 夹 中 包含 的 文件 总 数 。 


Sub 遍历 子 文件 夹 () 
Dim fso Rs New Scripting.FileSystemObject 
Dim fd As Scripting.Folder, fds As Scripting.Folder 
Set fd = fso.GetFolder("C:\CTEX") 
MsgBox " 子 文件 夹 个 数 为 : " & fd.SubFolders.Count 
Debug.Print "文件 夹 路 径 "，" 文件 总 数 " 
For Each fds In fd.SubFolders 
Debug.Print fds.Path, fds.Files.Count 
Next fds 
End Sub 


上 述 程序 的 运行 结果 如 图 1-39 所 示 。 


文件 夹 路 径 文件 总 数 
C:\CTEX\CTeX 0 
C:\CTEX\Ghostscript 0 
C:\CTEX\GSview 0 
C:\CTEX\Logs 1 
C:\CTEX\MiKTeX 0 
C:\CTEX\UserData 0 
C:\CTEX\WinEdt 15 


图 1-39 每 个 文件 夹 包含 的 内 容 
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实际 上 ，Windows 的 文件 、 路 径 管 理 是 一 个 树 状 结构 ， 文 件 夹 中 可 以 包含 子 文件 夹 和 文 
件 , 子 文件 夹 也 是 一 种 文件 夹 ， 其 中 还 能 包含 子 文件 夹 和 文件 ， 从 逻辑 上 讲 ， 子 文件 夹 可 以 
无 限 层 嵌 套 。 

如 果 要 遍历 到 某 位 置 下 的 所 有 子 文件 夹 和 文件 ， 需 要 用 递归 算法 反复 访问 SubFolders 
才能 实现 。 

本 书 源 代码 文件 “实例 文档 02.xlsm” 中 的 UserForml 使 用 了 Treeview 控件 结合 递归 算 
法 来 展示 文件 夹 中 的 所 有 子 文件 夹 和 文件 ， 如 图 1-40 所 示 。 


[ 
[on 


图 1-40 递归 遍历 文件 管理 系统 


读者 可 以 下 载 源 代码 文件 自行 研究 。 
下 面 的 代码 使 用 递归 算法 遍历 任意 路 径 ， 并且 把 遍历 的 结果 发 送 到 Excel 单元 格 中 。 


Public Root Rs Folder, fd As Folder, fl As File 
Public Record As Long 
Private Sub Traversal() 
Dim FSO As New FileSystemObject 
Set Root = FSO.GetFolder("E:\ExcelObject_ VSTO VBA") 
ActiveSheet .UsedRange.ClearContents 
Record = 0 
Recursion Root，0 
End Sub 
Private Sub Recursion (BYVal CurrentFolder Rs Folder, ByVal Layer Rs Integer) 
Layer = Layer + 1 
Record = Record + 1 
ActiveSheet.Cells (Record, Layer) .Value = CurrentFolder.Name 
For Each fl In CurrentFolder.Files 
Record = Record + 1 
ActiveSheet.Cells (Record, Layer + 1) .Value = fl.Name 
Next fl 
For Each fd In CurrentFolder.SubFolders 
If fd.SubFolders.Count + fqd.Files.Count > 0 Then 
Recursion fd, Layer 
End If 
Next fd 
End Sub 


”office VBA 开发 经 典 -一 中 级 进 阶 郑 


运行 代码 中 的 Traversal 过 程 ， 从 根 目 录 “E:\ExcelObject VSTO_ VBA” 反 复 调用 
Recursion 过 程 ， 如 图 1-41 所 示 。 


1 ix v f ExcelObject_VSTO_VEA 
| A 1 D 和 FE [3 H 时 工 

国 [Eeeelobidc EE VBA 

2 | rcelobject VSTO VBA. SI 

3 ExrcelD0bject_VSTO. 人 Suo 

本 | Exzcel0hbj 

5 S10_VBA. caprej 

6 YSTO_ YEA TenporaryRey, IE 

7 Resourcel.) Designer. cs 

8 Resourcel. resx 

日 Ribbonl. cs 

10 Sharc. cs 

1 ThlshAddrn cs 

12 ThisAddIn. Designer. cs 

13 ThisAddIn. Desiener. xnl 

14 UserControll. ce 

15 UscrControll.Designer. cs 

16 UserControll. resy 

17 

18 Debue 

19 CodeLibrary.mdb 

20 

2 

2 

23 

24 

三 ‘cols. Conaon. v4. 0. Utilities. dll 
26 ;01s.Comnon. v4. 0. Utilities. xnl 
2 Release 

28 1 

29 

30 

UL 国 是 访 寺 示 代码 . 

4 Sheetl @ 


图 1-41 递归 遍历 的 结果 发 送 到 单元 格 
上 述 代码 的 源 文件 为 “实例 文档 03.xlsm”。 


1.3.10 ”FSO 的 更 多 操作 方式 


前 面 介 绍 过 的 文件 、 文 件 夹 的 操作 ( Copy、Move、Delete) 是 以 文件 /文件 夹 对 象 为 主 
体 的 。 针 对 这 种 方式 ， ee 

FSO 允许 以 FSO 对 象 作为 主体 ， 情形 下 ， 以 通配符 作为 参数 ， 从 而 达到 一 行 代码 
就 可 以 批 处 理 文件 或 路 径 。 ee 6 个 : 

口 FSO.CopyFile 

口 FSO.CopyFolder 

口 FSO.MoveFile 

口 FSO.MoveFoler 

口 FSO.DeleteFile 

口 FSO.DeleteFoler 

文件 或 路 径 中 的 通配符 可 以 使 用 * 来 匹配 任意 多 个 字符 ， 也 可 以 使 用 ?匹配 任意 一 
个 字符 。 

假设 C:\temp 下 面 有 大 量 的 文件 夹 ， 下 面 的 过 程 可 以 把 p 开头 的 所 有 文件 夹 一 次 性 
删除 。 


Sub Test1() 
Dim FSO As New FileSystemObject 


第 1 章 “文件 和 路 径 操作 的 


FSO.DeleteFolder "C:\temp\p*" 
End Sub 


运行 上 述 过 程 ， 以 p 开头 的 文件 夹 就 被 删除 了 ， 如 图 1-42 所 示 。 


宣 最 5 访问 的 位 置 BB officeAssitant 文件 夫 2017/3/31 21:03 
他 OneDrive B OfficeFavorite 文件 夫 2017/5/12 11:11 
pic 文 从 夫 2017/7/4 928 
ET BB pubish 文件 夫 2016/9/18 18:13 
国 机 机 UDP 可 天 人 到 文件 实 2017/5/1 15:22 
图 片 [WB Reduce 文件 夫 2017/6/3 8:08 
加 BB Regdll 文件 去 2013/5/18 20:58 
Bresult 文件 夹 2017/6/1 16:15 
迅 盏 下 载 B RibbonXmlEditor_Source 文件 交 2017/12/6 1944 
由 言 乐 五 sendMail 文件 交 2017/12/1 19:12 


图 1-42 ”用 通配符 限定 被 处 理 的 文件 夹 


下 面 再 举 一 个 批量 移动 文件 的 实例 。datas 文件 夹 下 有 大 量 的 记事 本 文件 ， 下 面 的 代码 
可 以 把 一 位 数 命名 的 文件 批量 转移 到 2018 文件 夹 中 。 


Sub Test2() 

Dim FSO As New FileSystemObject 

FSO.MoveFile "C:\temp\datas\?.txt", "C:\temp\2018\" 
End Sub 


代码 分 析 : ?.txt 只 能 匹配 到 9.txt 等 ,但 是 不 能 匹配 12.txt， 也 就 是 说 ?只 能 代表 一 个 字 
符 。 因 此 ,运行 上 述 过 程 后 ， 图 中 框 内 的 文件 被 批量 转移 ， 如 图 1-43 所 示 。 


中 与 到 3 目 laed 
册 和 岛 允 9 目 lsea 


1-43 ”用 通配符 限定 文件 
此 外 ,使 用 FSO 还 可 以 快速 获取 计算 机 中 的 特殊 文件 夹 。 


Sub Test3() 
Dim FSO As New FileSystemObject 
Debug.Print FSO.GetSpecialFolder (0) ，" 操作 系统 文件 夹 " 
Debug.Print FSO.GetSpecialFolder(1),， "System32 文件 夹 " 
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Debug.Print FSO.GetSpecialFolder (2)，" 临时 文件 夹 " 
End Sub 


上 述 程序 的 运行 结果 如 图 1-44 所 示 。 


C:\Windows 操作 系统 文件 赤 
C:\Windows\System32 System32 文 件 夹 
C:\Users\ryueifu\AppData\Local\Temp 临时 文件 夹 


图 1-44 获取 特殊 文件 夹 


1.3.11 ”判断 是 否 存在 


在 利用 FSO 对 计算 机 中 的 磁盘 分 区 、 文 件 夹 、 文 件 进行 操作 时 ， 必 须 事先 确保 目标 存 
在 方 可 进行 操作 ， 因 此 ，FSO 提供 了 DriveExists 、FolderExists 、FileExists 三 个 函数 来 快速 
判断 目标 是 否 存在 ， 这 三 个 函数 都 返回 布尔 值 ， 如 果 存 在 则 返回 True。 

以 下 三 行 代 码 分 别 判断 计算 机 中 是 否 存在 开盘 、 文 件 夹 C:\temp， 以 及 是 否 存 在 Test. 
Spec 文件 。 


Sub Test4() 
Dim FSO Rs New FileSystemObject 
Debug.Print FSO.DriveExists("K:") 
Debug.Print FSO.FolderExists("C:\temp\") 
Debug.Print FSO.FileExists("D:\Test.spec") 
End Sub 


下 面 的 代码 先 判 断 C: 盘 下 是 否 有 Download 文件 夹 ， 如 果 没 有 ， 则 创建 这 个 文件 夹 。 


Sub Test5() 
Dim FSO Rs New FileSystemObject 
If FSO.FolderExists("C:\Download\") = False Then 
FSO.CreateFolder "C:\Download\" 
End If 
End Sub 


在 日 常 办 公 中 ， 经常 需要 在 成 千 上 万 个 文件 中 核对 哪些 文件 存在 ， 哪 些 文件 没有 ， 现 在 
假设 C\Example 文件 夹 下 有 大 量 的 压缩 包 文件 ,理论 上 从 1 月 1 日 到 1 月 20 日 的 文件 名 都 
有 。 现 在 需要 核对 哪些 日 期 的 文件 不 存在 ， 如 图 1-45 所 示 。 


系统 (CJ ，Example 
= 一 = 一 
共享 ”新建 文件 去 
转 2018o10lrar 履 20180102.rar 履 20180104.rar ] 
署 2018o1o0srar 履 20180106rar 改 20180107.rar 
虱 20180109.rar 履 20180110.rar 改 2018011Lrar 
改 20180112.rar 履 20180113.rar 改 20180114.rar 
履 20180115.rar 履 20180116.rar 屠 20180117.rar 
改 20180118.rar 转 2018ol2orar 


1-45 文件 夹 中 的 内 容 
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下 面 的 过 程 ， 在 日 期 中 循环 ， 通 过 变化 的 日 期 产生 临时 的 文件 名 ， 然 后 用 FSO 的 
FileExists 来 判断 该 日 期 对 应 的 文件 是 否 存在 ， 不 存在 的 话 就 打印 到 立即 窗口 。 


Sub 检查 文件 是 否 存在 () 
Dim FSO As New FileSystemObject 
Dim i As Date 
Dim parent As String 
Dim fname As String 
parent = "C:\Example\" 
For i = #1/1/2018# To #1/20/2018# 
fname = Format (i, "yyyymmdd") & ".rar™" 
IE FSO.FileExists (parent & fname) = False Then 


Debug.Print fname，" 不 存在 ! " ET 
End If 20180103. rar 不 存在 ! 
Next i 20180108. rar 不 存在 ! 
End sub 20180119. rar 不 存在 ! 
运行 上 述 过 程 ， 文件 夹 中 不 存在 的 文件 名 打印 在 立即 窗 图 1-46 检查 哪些 名 称 的 
口中 ， 如 图 1-46 所 示 。 文件 夹 不 存在 


1.3.12 ”文本 文件 的 读 写 


计算 机 中 的 文件 大 体 可 以 分 为 文本 文件 和 二 进 制 文件 两 大 类 ， 文本 文件 可 以 用 
Windows 自 带 的 记事 本 软件 打开 ,二进制 文件 (图 片 、Word 文档 ) 则 不 能 用 记事 本 打开 。 

在 编程 过 程 中 ,经 常 需要 对 文本 文件 进行 读 写 。 下 面 介绍 利用 FSO 中 的 TextStream 对 
象 操作 文本 文件 。 

对 文件 的 读 写 操作 分 为 以 下 三 个 环节 。 

口 打开 文件 (OpenTextStream ) 。 

口 读 / 写 (Read、Write、Append)。 

口 关 闭 文件 (Close)。 


1. 打开 文件 

OpenTextStream 函数 返回 一 个 TextStream 文件 对 象 ， 该 函数 有 以 下 4 个 参数 。 

口 FileName: 文件 路 径 。 

口 IOMode : 读 写 模式 ， 有 ForReading 、ForWiiting、ForAppending 三 种 模式 ， 含 义 分 别 是 读 
取 、 写 和 人 和 追加 写 入 。 

口 Create: 当 文件 不 存在 时 ， 询 问 是 否 创建 。 该 参数 默认 值 为 False。 

口 Fomat: 编码 格式 ， 取 值 必 须 是 以 下 三 者 之 一 ，TristateFalse (以 ANSI 格 式 打开 )、TristateTrue 
(以 Unicode 格式 打开 )、TristateUseDefault (使 用 系统 默认 打开 )。 


2. 写 入 文件 

TextStream 对 象 写 人 文件 的 方法 有 如 下 三 种 。 

口 Write: 当前 位 置 写 人 一 个 字符 串 。 

口 WriteLine: 当前 位 置 写 入 一 个 字符 串 ， 并 在 后 面 自动 加 一 个 换行 符 。 
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口 WriteBlankLines: 写 人 多 个 空 行 。 
以 下 代码 向 记事 本 文件 中 自动 写 入 一些 内 容 。 


Sub WriteMethod () 
Dim FSO As New FileSystemObject 
Dim txt As TextStream 
Set txt = FSO.OpenTextFile(Filename:="C:\temp\new.txt", IOMode:=ForWriting, 
Create:=True, Format:=TristateFalse) 
With txt 
.Write " 春雨 惊 春 清 谷 天 " 
-WriteLine " 夏 满 芒 夏 署 相 连 " 
-WriteBlankLines 3 
.Write " 冬 雪 雪 冬 小 大 寒 " 


.Close 
End With 
End Sub 
代码 分 析 : 以 上 代码 用 ANSI 格式 打开 new.txt， 如 果 路 径 下 不 存在 该 记事 本 文件 ， 则 会 
自动 创建 一 个 空 文件 。 ES 


Write 方法 写 人 内 容 后 ， 继 续 写 人 的 内 容 会 紧 跟 || 尝 主 屋 大 站 二 天 是 汪 过半 村 过 


其 后 写 和 信 。 代 码 中 的 WriteBlankLines 3 表示 输入 三 
个 换行 符 。 写 人 操作 完毕 后 ， 别 忘记 用 Close 方法 || 冬 雪 雪 冬 小 大 割 
关闭 文件 。 
上 述 程序 的 运行 结果 如 图 1-47 所 示 。 图 1-47 写 入 文本 文件 


3. 读 取 文 件 
TextStream 对 象 用 于 读 取 文 本 文件 内 容 的 方法 有 如 下 三 种 。 
口 Read(i): 在 当前 位 置 读 取 i 个 字符 。 
口 ReadLine: 读 取 一 整 行 。 
口 ReadAll: 读 取 整个 文件 内 容 。 
当 一 个 文本 文件 被 打开 时 ， 指 针 处 于 文本 内 容 ”[ 国 newets 
= 2024 
的 起 始 位 置 ， 读 取 过 程 中 ,指针 (当前 位 置 ) 随 之 向 “| 详 伯 9， 忽 总 (日 “格式 (0)。 喜 看 VM 者 助 (H) 
右 移动 。 春雨 惊 春 清 谷 天 
假定 new.txt 文 件 中 有 一 首 完整 的 二 十 四 节气 
歌 ， 如 图 1-48 所 示 。 
下 面 用 Read 和 ReadLine 方法 来 读 取 一 部 分 内 
容 ， 赋 给 过 程 中 的 变量 。 
Sub ReadMethod () 
Dim FSO As New FileSystemObject 
Dim txt As TextStream 
Dim result(1 To 4) As String 
Set txt = FSO.OpenTextFile(Filename:="C:\temp\new.txt", IOMode:=ForReading, 


Format :=TristateFalse) 
With txt 


秋 处 露 秋 寒 霜 
冬 雪 雪 冬 小 大 赛 


图 1-48 文本 文件 的 内 容 
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result(1) = .Read(5) 
result (2) = .Read(5) 
result(3) = .ReadLine 
“Close 

End With 


Debug.Print result (1) 

Debug.Print result (2) 

Debug.Print result (3) 
End Sub 


代码 分 析 : 文件 打开 后 ， 指 针 位 于 “ 春 ” 之 
前 ，result(1) 读 取 5 个 字符 ， 指 针 移动 到 “ 清 ”之 后 ， 
result(2) 从 当前 位 置 再 读 取 5 个 字符 ， 也 就 是 读 取 “ 谷 | 茵 E 页 也 入 连 
天 "、 回 车 符 (vbCn)、 换行 符 (vbLD、" 夏 ,总计 5 个 ，|， 
各 图 349 A 图 1-49 文件 污 取 方法 

result(3) 从 当前 位 置 读 取 到 行 尾 。 

在 实际 编程 过 程 中 ， 经 常 需要 把 记事 本 中 的 多 行文 本 按 行 读 取 ， 发 送 到 单元 格 中 ,或 者 
列表 框 控件 等 ， 此 时 使 用 ReadLine 是 最 好 的 选择 。 

如 果 要 一 次 性 读 取 所 有 内 容 ， 发 送 给 文本 框 控件 ， 用 ReadAll 最 省 事 。 

下 面 两 个 过 程 分 别 采用 ReadLine .ReadAll 方法 从 文本 文件 中 读 取 内 容 ， 发 送 到 列表 框 、 
文本 框 中 。 


Dim FSO Rs New FileSystemObject 
Private Sub CommandButtonl Click() 
Dim txt Rs TextStream 
Set txt = FSO.OpenTextFile (Filename:="C:\temp\new.txt", IOMode:=ForReading, 


春雨 惊 春 清 
合 


result(2) 


Format:=TristateFalse) 

With txt 
Me.ListBoxl.Clear 
Do Until .AtEndofstream 

Me.ListBoxl.AddItem .ReadLine 

Loop 
.Close 

End With 

End Sub 


Private Sub CommandButton2 Click() 
Dim txt As TextStream 
Set txt = FSO.OpenTextFile (Filename:="C:\temp\new.txt", IOMode:=ForReading, 


Format :=TristateFalse) 


With txt 
Me.TextBoxl.Text = "" 
Me.TextBoxl.Text = .ReadAll 
-Close 

End With 


End Sub 
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代码 分 析 : 在 使 用 TextStream 对 象 的 Read ”sromnL 9 
以 及 ReadLine 方 法 时 ， 一 定 要 判断 是 否 已 读 取 到 列表 框 中 读 取 到 多 行文 本 框 中 


经 读 取 到 文件 末尾 。 当 读 取 到 文件 末尾 时 ， 
TextStream 对 象 的 AtEndOfStream 属性 会 返回 
Trme， 因 此 经 常 利 用 该 属性 配合 Do 循环 读 取 
所 有 内 容 。 | 
上 述 程序 中 ， 左 侧 是 一 个 列表 框 控件 ， 右 | 
侧 是 一 个 文本 框 (MultiLine 为 True)。 = 
上 述 程序 的 运行 结果 如 图 1-50 所 示 。 图 1-50 ”从 文本 文件 读 取 内 容 到 控件 
读 取 文件 的 过 程 中 ， 还 可 以 使 用 Skip 或 
SkipLine 方法 跳 过 字符 或 跳 过 行 ， 相 当 于 主动 改变 指针 位 置 。 
还 是 以 二 十 四 节气 歌 为 例 ， 理 解 一 下 Skip 的 作用 。 


Sub SkipMethod () 
Dim FSO Rs New FileSystemObject 
Dim txt As TextStream 
Dim result(1 To 4) As String 
Set txt = FSO.OpenTextFile(Filename:="C:\temp\new.txt", IOMode:=ForReading, 
Format :=TristateFalse) 
With txt 
result (1) = .Read(2) 
.Skip 2 
result (2) = .Read(2) 
.Close 
End With 
Debug.Print result(1) 
Debug.Print result(2) 
End Sub 


代码 分 析 : 打开 文件 后 ，result(1) 首先 读 取 前 2 个 字符 “春雨 "，Skip 2 表示 跳 过 2 个 
字符 (“ 惊 春 ”两 个 字 被 跳 过 )， 接 着 result(2) 读 取 两 个 字符 ， 也 就 是 读 取 “ 清 谷 ”两 个 字 。 
下 面 的 代码 演示 了 如 何 跳 过 整 行 。 


Sub SkipLineMethod () 
Dim FSO Rs New FileSystemObject 
Dim txt As TextStream 
Dim result(1 To 4) As String 
Set txt = FSO.OpenTextFile (Filename:="C:\temp\new.txt", IOMode:=ForReading, 
Format :=TristateFalse) 
With txt 
result (1) = .ReadLine 
.SkipLine 
.SkipLine 
result (2) = .ReadLine 
-Close 
End With 
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Debug.Print result(1) 
Debug.Print result(2) 
End Sub 


运行 上 述 过 程 ， 立 即 窗口 的 结果 如 图 1-51 所 示 。 
以 上 内 容 的 源 代码 文件 为 “实例 文档 04.xlsm”。 图 1-51 跨行 读 取 内 容 


1.4 使 用 ADODB.Stream 实现 文件 读 写 


对 于 UTF-8 编码 的 含 中 文 的 文本 文件 ， 无 论 是 以 传统 方式 , 还 是 用 FSO 的 TextStream 
对 象 打开 ， 读 取 到 的 内 容 会 出 现 乱 码 。 

本 书 源 文件 “ utf-8File.txt” 文 件 中 也 是 一 首 二 十 四 节气 歌 ,但 是 该 文件 的 编码 格式 是 
UTF-8， 如 图 1-52 所 示 。 


司 utf-8Filetd -记事 本 em 全 
EECEOREVRCCO 
川 春雨 惊 春 清 谷 天 
夏 满 芝 夏 暑 相 连 | 司 另 为 
让 
上 组 织 ” 新建 件 夫 St 
中 闷 过 
| 史家 三 
| 尘 计 算 机 di utf-8File.bd 
中 加 更 动 (A) 
上 |! 名 5 
局 元 屋 [Dj 
| 已 侦 回 
加 软件 四) 
用 WW My Web Sites «~ 
HEN} 二 
机 全 类 型: [文本 文 村 Cd “ 
| 5 Ee 


图 1-52 ”UTF-8 编码 的 文本 文件 
使 用 前 面 讲 过 的 FSO 方式 读 取 该 文件 ， 读 取 到 的 是 乱码 ， 如 图 1-53 所 示 。 


省 必 江 避 大 合生 二 eg 
弧 钴 拣 。” 鲁 哉 源 

妆 斤 间 茬 委 癌 洛 届 ? 

狠 珠 汝 关 ” 响 汝 慎 翅 滩 ? 


图 1-53 不 期 望 的 读 取 结果 
下 面 讲述 一 种 能 够 按照 指定 编码 打开 文件 的 方式 : ADODB.Stream 对 象 。 
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1.4.1 对象 的 引入 


ADODB 是 一 个 非常 重要 的 对 象 ， 经 常用 于 数据 库 操作 ， 在 后 面 的 章节 会 探讨 ADODB 
操作 数据 库 方面 的 知识 ， 本 节 介 绍 一 下 ADODB.Stream 读 写 文件 。 


前 期 绑 定 : 工程 中 添加 引用 “Microsoft ActiveX Data Objects 2.8”， 如 图 1-54 所 示 。 


引用 -VBAProject 
| 可 使 用 的 引用 A): 
回 Visual Basic For Applications 取消 


MMicrosoft Excel 15.0 Dbject Library 
MOLE Autonation 性 


Merosoft Qffice 15.0 Object Libra 浏览 8)... 


El osoft ActiyeX Data 
DVEAFroject 


Dbiects 2.8 


Aeees dlitycplAmin 1.0 Type Lib 优先 级 
DAccountProtect 1.0 Type Library 帮助 00 
口 Aetive DS Type Library + 

DActivellovie control type library 

DActiveX DLL to perform Migration o: 
DAdocReportingExcelClientLib 
[IannR 


加 二 一 | ; 


Microsoft ActiveX Data Objects 2.8 Library 


定位 :C:\Program Files\Conmon Files\Systen\ado\msado28. 1 
语言 : 标准 


图 1-54 添加 外 部 引用 


代码 中 声明 : Dim AStream As New ADODB.Stream， 会 看 到 自动 成 员 提 示 ， 说 明 绑 定 成 
功 ， 如 图 1-55 所 示 。 


Sub ReadFile() 


Dim AStream As New ADODB. Stream 
With AStream 罗 Command 


中 Connection 


-Type = adTypeText 瑞 Feweter 
.Mode = adModeReadW Fe 


Recordset 


.Charset = “utf-8” 
.Open 
+ LoadFromFile (“C:\temp\utf-8File. txt”) 
Debug. Print .ReadText 
End With 
End Sub 


图 1-55 使 用 ADODB.Stream 


后 期 绑 定 : 在 工程 中 不 添加 ADODB 的 前 提 下 ， 使 用 CreateObject("ADODB.Stream") 
创建 一 个 新 的 Stream 对 象 。 


1.4.2” 读 取 文 本 文件 


ADODB.Stream 对 象 通过 LoadFromFile 方法 载 入 文本 文件 ， 然 后 用 ReadText 方法 读 取 
所 有 内 容 。 


如 果 ReadText 后 面 不 带 参数 ， 则 相当 于 FSO 中 的 ReadAll， 读 取 全 部 内 容 ， 如 果 是 
ReadText i， 则 表示 读 取 ii 个 字符 。 
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但 是 在 装载 文件 之 前 ， 必 须 预 设 ADODB.Stream 对 象 的 若干 属性 。 

口 Type 属性 : 读 写 文本 文件 用 adTypeText(2)， 读 写 二 进 制 文件 用 adTypeBinary(])。 
口 Mode 属性 : 使 用 adModeReadWrite(3)， 可 读 写 。 

口 CharSet 属性 : 指定 文件 编码 ， 要 根据 文本 文件 的 编码 来 设 定 。 

以 下 过 程 读 取 UTF-8 格式 的 二 十 四 节气 歌 的 前 四 个 字符 。 


Sub ReadFile() 
Dim AStream Rs New ADODB.Stream 
Dim result As String 
With AStream 
.Type = adTypeText 
.Mode = adModeReadWrite 
.Charset = "utf-8" 
.Open 
.LoadFromFile ("C:\temp\utf-8File.txt" 
result = .ReadText (4) 
.Close 
End With 
Debug.Print result 
End Sub 


上 述 过 程 的 打印 结果 是 :“ 春 雨 惊 春 ”。 如 果 把 ReadText(4) 改 成 ReadText， 则 读 取 出 所 
有 内 容 。 
对 应 的 后 期 绑 定 代码 如 下 所 示 。 
Sub LaterBind() 
Dim AStream As Object 
Dim result As String 


Set AStream = CreateObject ("RDODB .Stream" ) 
With AStream 


.Type = 2 

Mode = 3 

.Charset = "utf-8" 
.Open 


.LoadFromFile ("C:\temp\utf-8File.txt") 
result = .ReadText (4) 
Close 
End With 
Debug.Print result 
End Sub 


需要 注意 的 是 ， 由 于 代码 中 采用 了 后 期 绑 定 方式 ， 并 未 在 工程 中 添加 ADODB 引用 ， 
因此 Type、Mode 等 属性 不 能 用 枚 举 常量 ， 只 能 使 用 枚 举 常量 的 等 价值 。 


1.4.3” 写 入 文本 文件 


使 用 ADODB.Stream 写 入 文本 文件 的 步骤 是 : 创建 对 象 一 设 定 属性 一 打开 对 象 一 写 人 
内 容 一 保存 到 文件 一 关闭 对 象 。 
下 面 的 代码 把 一 个 字符 串 重复 两 次 写 和 文本 文件 ， 并 保存 为 UTF-8 格式 。 
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Sub WriteFile() 
Dim AStream As New ADODB.Stream 


Const result Rs String = "天 长 地 久 有 没有 " & vbNewLine & " 浪漫 传说 说 太 多 " 
With RStream 
.Type = adTypeText 


-Mode adModeReadWrite 
.Charset = "utf-8" 
-Open 


-WriteText result 
-WriteText result 
.SaveToFile "C:\temp\t.txt", adSaveCreateOverWrite 


-Flush 
.Close 
End With EE 
So SD 文件 (月 ” 编 甸 旧 ” 格 3t(O) 坦 看 V) 帮助 (H) 
代码 分 析 : 枚 举 常量 adSaveCreateOverWrite(2) ”|| 藉 长 地 久 有 没有 
浪漫 传说 说 太 多 天 长 地 久 有 没有 
表示 如 果 目 标 文件 已 存在 ， 则 覆盖 保存 。 浪漫 传说 说 人 多 
运行 上 述 过 程 ， 再 次 打开 记事 本 文件 ， 如 图 
1-56 所 示 。 


图 1-56 保存 为 UTF-8 文件 
1.4.4 利用 ADODB.Stream 下 载 网 页 附件 


除了 文本 文件 以 外 ，ADODB.Stream 还 可 以 读 写 二 进 制 文件 。 在 二 进 制 文件 代码 编写 方 
面 ， 需 要 改动 的 地 方 主要 有 以 下 两 个 。 


口 Type 属性 : 需要 改 为 adTypeBinary。 
口 ReadText 方法 、WriteText 方法 分 别 更 改 为 Read、Write。 


下 面 讲 解 ADODB.Stream 对 象 联合 使 用 XMLHttp 对 象 ， 实 现 网 页 附件 下 载 到 本 地 的 
功能 。 


XMLHttp 对 象 经 常用 于 向 HITP 服务 器 发 送 请 求 ， 其 前 期 绑 定 方式 是 向 工程 中 添加 引 
用 “Microsoft XML v6.0”"， 如 图 1-57 所 示 。 


引用 - VBAProject 
可 使 用 的 引用 凡 ): 
| 


MVisual Basic 了 or Applications 
MMicrosoft Excel 15.0 Object Library 

OLE Automation 站 
Microsoft Office 15.0 Object Libra 浏览 @).. 
| | 四 mieroseft Scripting Runtime 

和 ActiveX Data Objects 2.8 二 


DVBAProject 优先 级 
DAccessibilityCplAdnin 1.0 Type Lib 帮助 00 
DAccountProtect 1.0 Type Library 要 

口 Aetive DS Type Library 


Activellovie control type library 
Dctivex DIL to perform rtion 0: 
门 aayacRenortinogvea1ri 


四- 
erosoft XML, v6.0 
定位 : C:\Windows\System32\msxml6. dll 
语言 : 标准 


图 1-57 添加 外 部 引用 
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后 期 创建 对 象 的 方法 是 : CreateObject("Microsoft.XMLHTTP")。 

XMLHttp 对 url 完成 请 求 后 ,返回 的 ResponseBody 是 一 个 未 解码 的 二 进 制 数据 ， 因 此 ， 
得 到 这 个 二 进 制 数据 后 ,用 ADODB.Stream 写 和 人 计算 机 中 的 文件 即 可 实现 附件 的 下 载 。 

下 面 的 实例 从 WinRAR 压缩 软件 的 官方 网 站 下 载 WinRAR 5.50 的 安装 文件 。 


Sub DownLoadFile() 
Dim AStream As New ADODB.Stream, X As New XMLHTTP, Content() As Byte 
With Xx 
.Open "GET", "http://www.winrar.com.cn/download/wrar550scp.exe", False 


.send 
Do Until .readyState = 4 
DoEvents 
Loop 
Content = .responseBody 
End With 


With RStream 
.Type = adTypeBinary 
.Mode = adModeReadWrite 
.Open 
.Write Content 
.SaveToFile "C:\temp\Winrar550.exe", adSaveCreateOverWrite 
.Close 

End With 

End Sub 


代码 分 析 : Content() 是 一 个 字 节 数组 ， 用 于 存储 XMLHttp 返回 的 ResponseBody， 然 后 
用 ADODB.Stream 的 Write 方法 ， 把 Content 保存 为 文件 。 

运行 上 述 过 程 后 ，C:temp\ 文件 夹 下 多 了 一 个 Winrar550.exe 文件 。 

以 上 内 容 的 源 代码 文件 为 “实例 文档 05.xlsm”。 


1.5 本章 小 结 


本 章 讲解 了 使 用 传统 方式 和 使 用 FSO 处 理 文件 、 文 件 夹 的 方法 以 及 文本 文件 内 容 的 读 
写 方法 等 知识 点 。 

对 于 读 写 UTF-8 格 式 的 文本 文件 ， 为 了 避免 读 出 的 内 容 出 现 乱码 ， 使 用 ADODB. 
Stream 对 象 实现 了 二 进 制 字 节 数组 和 字符 串 的 正确 转换 。 
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文件 系统 自动 化 


编程 开发 时 ， 经 常 要 对 计算 机 中 的 文件 、 文 件 夹 用 代码 自动 打开 、 自 动 选中 或 者 自动 用 
默认 的 浏览 器 打开 某 个 网 页 。 在 VBA 中 可 以 使 用 Shell 函数 来 代替 这 些 手工 操作 。 
如 果 要 实现 自动 发 送 按键 、 自 动 创建 桌面 快捷 方式 、 自 动 读 写 注册 表 ， 使 用 WshShell 对 象 。 
因此 ， 本 章 将 介绍 Shell 函数 实现 文件 系统 自动 化 、 用 代码 操作 注册 表 、 自 动 发 送 按键 
三 大 部 分 。 
本 章 用 到 的 外 部 引用 和 重要 对 象 如 下 。 
口 Windows Script Host Object Model 
> IWshRuntimeLibrary.WshShell 
> IWshRuntimeLibrary. WshNetwork 


2.1 ”Shell 晃 数 


Shell 用 于 执行 一 个 可 执行 文件 ， 返 回 一 个 Variant (Double) 类 型 的 结果 ， 如 果 成 功 ， 代 
表 这 个 程序 的 任务 ID ， 若 不 成 功 ， 则 会 返回 0。 
Shell 的 语法 格式 是 : 


Shell (PathName,WindowStyle) 
具体 的 参数 说 明 : 
口 PathName: 是 一 个 字符 串 ， 必 须 包含 一 个 可 执行 文件 的 名 称 ， 后面 还 可 以 加 上 一 些 
命令 参数 ， 各 个 参数 之 间 用 空格 隔 开 。 
口 WindowStyle: 枚 举 常量 ， 用 来 规定 窗口 样式 ， 如 表 2-1 所 示 。 
表 2-1 Shell 命令 的 窗口 样式 常量 


vbHide 窗口 被 隐藏 ， 且 焦点 会 移 到 隐 式 窗口 


vbnormalFocus 窗口 具有 焦点 ， 且 会 还 原 到 它 原来 的 大 小 和 位 置 
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续 表 
常 量 描 述 
vbMinimizedFocus 窗口 会 以 一 个 具有 焦点 的 图 标 来 显示 
vbMaximizedFocus 窗口 是 一 个 具有 焦点 的 最 大 化 窗口 
vbNormalNoFocus 窗口 会 被 还 原 到 最 近 使 用 的 大 小 和 位 置 ， 而 当前 活动 的 窗口 仍然 保持 活动 
vbMinimizedNoFocus 窗口 会 以 一 个 图 标 来 显示 ， 而 当前 活动 的 窗口 仍然 保持 活动 


需要 注意 的 是 ,在 VBA 或 VB6 编程 中 ，Shell 函数 是 内 置 函数 ， 不 需要 添加 任何 外 部 
引用 ， 也 不 需要 创建 对 象 。 

Shell 函数 的 功能 可 以 这 样 理解 ， 就 是 代替 手工 去 打开 某 个 应 用 程序 或 文档 。 

实际 上 ， 屏 幕 上 面 的 窗口 的 根源 绝 大 多 数 都 来 源 于 一 个 可 执行 文件 (扩展 名 为 .exe)。 
例如 微软 的 Word， 其 窗口 根本 路 径 是 Office 安装 路 径 下 的 WINWORD.EXE 文件 ， 当 打开 
一 个 文本 文件 时 ， 其 根源 文件 是 C:\Windows\System32\notepad.exe。 那 么 Windows 系统 中 
的 可 执行 文件 ， 一 部 分 是 系统 自 带 的 ， 例 如 记事 本 、 计 算 器 、 注 册 表 编辑 器 等 ， 它 们 都 处 于 
System32 文件 夹 下 ， 是 系统 内 置 可 执行 文件 。 而 另 一 部 分 如 QQ、Excel 这 些 应 用 软件 则 是 
后 期 安装 上 的 ， 根 源 文件 往往 位 于 用 户 指定 的 路 径 。 

为 了 更 好 地 理解 Shell 函数 的 原理 ， 下 面 使 用 计算 机 的 “运行 ”窗口 完成 一 些 动作 。 按 
下 快捷 键 【 Windows + R ]， 在 屏幕 左下 角 弹 出 “运行 ”窗口 ， 如 图 2-1 所 示 。 


将 根据 您 所 给 入 的 名 | 
文件 夫 . 文档 或 Internet 资源 


打开 (QO): C\windows\System32\notepad.exe Ci\temp\newhbx ~ 
加 使用 管理 权限 创建 此 任务 


Cm ]| mw )] (wesw | 


图 2-1 运行 窗口 


在 路 径 框 中 输入 : C:\windows\System32\notepad.exe Ci\tempnew.txt， 单 击 “ 确 定 ”按钮 ， 
就 可 以 看 到 桌面 自动 弹出 记事 本 ,并 能 看 到 其 中 的 内 容 。 

我 们 仔细 分 析 路 径 的 构成 ，C:\windows\System32\notepad.exe 其 实 就 是 系统 文件 记事 本 
的 根源 文件 ， 空 格 后 面 的 路 径 是 命令 参数 部 分 ， 也 就 是 告诉 记事 本 程序 ， 要 打开 这 个 文件 ， 
而 不 是 其 他 的 文本 文件 。 

针对 以 上 实例 ， 可 以 使 用 下 面 的 Shell 函数 来 达到 同样 目的 。 只 需要 把 “运行 ”中 的 内 
容 传递 给 Shell 函数 即 可 。 

Sub Testl() 

Shell "C:\windows\System32\notepad.exe C:\temp\new.txt", vbMaximizedFocus 


End sub 


上 述 代 码 中 的 vbMaximizedFocus 表示 打开 的 记事 本 窗口 取得 焦点 ， 并且 最 大 化 记 
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事 本 窗口 ， 如 果 改 为 vbHide， 则 打开 的 新 窗口 在 屏幕 上 看 不 见 ， 在 某 些 场合 下 这 样 是 很 
危险 的 。 

对 于 上 述 过 程 ， 我 们 要 认识 到 以 下 几 点 。 

口 Shell 函数 的 参数 由 可 执行 文件 的 路 径 以 及 命令 参数 路 径 构成 。 

口 可 执行 文件 的 路 径 ， 根 据 需要 可 以 尽 可 能 缩短 简化 。 

口 命令 参数 不 是 必需 的 ， 如 果 不 带 命令 参数 ， 则 默认 只 打开 该 应 用 程序 

由 于 上 例 中 的 notepad.exe 处 于 系统 文件 夹 中 ， 系统 的 环境 变量 中 一 定 有 C:\Wwindows\ 
System32 这 个 路 径 。 因 此 ，Shell 函数 还 可 以 省 略 所 在 路 径 ， 以 及 后 面 的 扩展 名 ， 从 而 简化 
为 : Shell "notepad C:\temp\new.txt", vbMaximizedFocus。 

如 果 不 打 开具 体 的 文件 ， 只 打开 记事 本 ， 则 不 需 带 命令 参数 。 进 一 步 简 化 为 : 

Shell "notepad" 

根据 以 上 心得 ,我 们 尝试 用 下 面 的 代码 打开 一 个 Word 文档 。 

Shell "WinWord C:\temp\ 公务 员 .docx" 


代码 中 的 WinWord 是 Office 安装 文件 夹 中 Word 程序 的 主 文件 ， 如 图 2-2 所 示 。 
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图 2-2 Word 的 执行 文件 


2.1.1 System32 中 常用 的 可 执行 文件 


Windows 系统 中 ， 很 多 实用 的 工具 都 处 于 System32 这 个 文件 夹 下 ， 因 此 可 以 利用 Shell 
函数 调用 这 些 可 执行 文件 ， 完 成 一 些 特定 的 任务 。 比 较 常 用 的 可 执行 文件 如 表 2-2 所 示 。 


表 2-2 常用 的 可 执行 文件 


文件 名 功能 描述 
calc.exe 3 
cmd.exe 执行 DOS 命令 
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续 表 

文 件 名 中 文 名 功能 描述 
control.exe 控制 面板 设置 系统 性 能 、 印 载 程序 等 
explorerexe ' 我 的 电脑 资源 管理 器 
msconfig.exe 系统 实用 配置 程序 配置 开机 启动 项 等 
mspaint.exe 画图 图 片 编辑 
notepad.exe 记事 本 文本 文件 读 写 
regedt32.exe 注册 表 编 辑 器 
TegsVI32.eXe 注册 注册 和 取消 注册 文件 
shutdown.exe 关机 自动 关机 
taskmgrexe 任务 管理 器 结束 应 用 程序 等 
taskkill.exe 结束 任务 st 


GD 这 类 文件 有 可 能 不 在 System32 文件 夹 中 


2.1.2 执行 DOS 命令 


DOS 命令 的 可 执行 文件 是 cmd.exe， 用 Shell 函数 调用 DOS 命令 后 ， 会 弹出 黑屏 窗口 ， 
当 DOS 命令 执行 完毕 后 ， 有 可 能 自动 退出 黑屏 ， 也 有 可 能 停留 ， 这 取决 于 cmd 的 参数 。/c 


表示 自动 退出 ,水 表示 停留 


下 面 的 代码 ， 首 先 切换 磁盘 分 区 到 D 盘 ， 其 次 切换 当前 目录 到 Download 文件 夹 ， 最 后 


用 Shell 函数 调用 DOS 窗口 ， 用 dir 命令 列举 出 该 文件 夹 中 的 内 容 


Sub 调用 DOS () 

ChDrive "D:" 

ChDir "D:\Download" 

Shell "cmd /k dir", vbNormalFocus 
End Sub 


由 于 cmd 的 参数 使 用 了 水 ， 因 此 ， 当 dt 命令 执行 完 后 ， 黑 屏 仍 然 停 留 在 屏幕 


所 示 。 


| Ee CWndoa ton Ro Ar > 一 本 


图 2-3 Shell 调 用 DOS 命令 


上 ， 如 图 2-3 
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DOS 命令 众多 ， 此 处 仅 举 几 个 典型 的 例子 。 
下 面 的 代码 用 DOS 命令 自动 把 D: 盘 根 目 录 下 的 VMware10.7z 压 缩 包 (该 文件 大 约 
470MB) 复制 到 D:\Download 文件 夹 中 ， 并 试图 把 复制 后 的 文件 重 命名 。 


Sub 复制 文件 () 
Shell "cmd /k copy D:\VMwarel10.7z D:\Download\", vbNormalFocus 
Name "D:\Download\VMwarel10.7z" Rs "D:\Download\VMwareNew.7z" 


End Sub 
运行 上 述 过 程 ， 当 运行 到 第 二 行 时 ， 弹 出 如 。 Maosoh Visual Basic 
下 的 运行 时 错误 ， 如 图 2-4 所 示 。 ee 


路 径 /文件 访问 凡 误 


结束 程序 后 ， 可 以 看 到 Download 文件 夹 下 确 
实 多 了 一 个 文件 。 也 就 是 说 ， 复 制 操作 成 功 地 执 
行 了 ， 但 是 重 命名 失败 。 器 | 塘 甸 | [者 助 0 | 

导致 操作 失败 的 原因 是 ，Shell 函数 是 异步 执 
行 的 ， 也 就 是 说 ， 复 制 文件 的 宿主 程序 是 cmd 文 
件 ， 并 不 是 VBA 代码 。 因 此 VBA 并 不 能 监测 到 cmd 那 边 复制 操作 是 否 已 经 完成 。 换 句 话 
说 ， 在 VBA 中 执行 一 句 Shell 语句 几乎 不 花 时间 ， 而 实际 上 的 复制 动作 可 能 持续 好 几 秒 或 
好 几 分 钟 。 由 于 VBA 监测 不 到 复制 的 状态 ， 就 立即 运行 后 续 的 代码 ， 进 行 重 命名 ， 出 现 运 
行 时 错误 也 就 可 以 理解 了 。 


2.1.3 认识 Shell 函数 的 异步 


为 了 提高 Shell 函数 的 健壮 性 ， 利 用 Shell 函数 的 返回 值 ， 再 配合 一 些 API 函数 ， 可 以 
让 程序 在 执行 Shell 函数 的 时 候 智 能 等 待 。 也 就 是 说 ， 只 有 Shell 函数 中 的 动作 已 完成 时 ， 
才 往 下 继续 执行 代码 ， 否 则 在 空 循环 中 等 待 。 

在 标准 模块 中 写 入 如 下 代码 。 


图 2-4 不 可 移动 或 重 命名 


Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As 
Long, lpExitCode As Long) As Long 

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject Rs Long) Rs Long 

Private Declare Function OpenProcess Lib "kerne132" (ByVal dwDesiredAccess As 
Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 

Const PROCESS QUERY INFORMATION = &H400 

Const STILL ALIVE = &H103 


Sub CopyFile() 
Dim Pid As Long, ExitCode As Long 
Pid = Shell("cmd.exe /c copy D:\VMwarel0.7z C:\lib\", vbNormalFocus) 
hProcess = OpenProcess (PROCESS QUERY INFORMATION, 0, Pid) 
Debug.Print "复制 进行 中 ...." 
Do 
Call GetExitCodeProcess (hProcess, ExitCode) 
DoEvents 
Loop While ExitCode = STILL ALIVE 
Call CloseHandle (hProcess) 
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Debug.Print "复制 已 完成 ! " 
Name "C:\lib\VMware10.7z" Rs "C:\1lib\VMware10_ 刘 永富 .7z" 
End Sub 


代码 分 析 : 当 文 件 正在 复制 时 ， 代 码 中 的 ExitCode 和 常量 STILL_ALIVE 是 相等 的 ， 都 
是 非 零 值 ， 此 时 跳 不 出 Do 循环 体 。 

当 复 制 动 作 完成 时 ，ExitCode 变 为 0，Do 循环 的 条 件 不 再 成 立 ， 就 跳出 并 执行 后 续 重 
命名 的 代码 。 

运行 上 述 CopyFile 过 程 ， 即 可 进行 先 复制 文件 ， 然 后 重 命名 复制 的 文件 ， 如 图 2-5 所 示 。 


OO" rn, a b a EE 
‖ an teamsm- #8 m4 
i 四 zw 修改 日 区 并 让 
及 VMware10 刘 富 7 ETE EE 
|= 
DD 
三 OneDrve 


图 2-5 处 理 Shell 的 异步 
因此 ， 只 要 Shell 函数 中 的 新 窗口 不 关闭 ， 就 不 会 跳出 Do 循环 ， 读 者 可 以 把 上 述 代码 
中 的 Pid = Shell("cmd.exe /c copy D:\VMware10.7z C:\libW, vbNormalFocus)， 更 改 为 Pid = 
Shell("notepad.exe", vbNormalFocus)， 再 试 一 次 ， 可 以 发 现 ， 弹 出 的 记事 本 窗口 如 果 不 手工 
关闭 ， 程 序 就 阻 滞 在 Do 循环 体 中 。 


2.1.4 ”处 理 Shell 函数 中 的 空格 


计算 机 的 文件 夹 或 文件 名 中 经 常 包 含 空 格 ， 如 果 把 包含 空格 的 路 径 作为 参数 传递 给 
Shell 函数 ， 该 函数 会 以 空格 作为 分 隔 符 ， 把 一 个 路 径 理解 为 多 个 参数 的 连接 。 
例如 ， 试 图 用 Word 2013 打开 C:temp 文件 夹 下 的 “公务 员 .docx”"， 如 果 写 成 如 下 形式 。 


Shell "C:\Program Files\Microsoft Office\Officel5\WINWORD.EXE C:\temp\ 公 务 员 .docx", 
vbNormalFocus 


执行 时 ， 并 不 能 打开 名 称 或 路 径 带 空格 的 文 
件 ， 而 是 弹出 如 图 2-6 所 示 错 误 对 话 框 。 


这 是 因为 不 仅 Word 的 路 径 包含 空格 , 而 且 | 
计划 打开 的 文档 名 称 也 有 空格 ，Shell 函数 无 法 解 


释 这 些 参数 的 含义 ， 因 此 不 能 打开 。 人 

如 果 为 Shell 函数 中 各 路 径 事先 用 双 引号 包 起 来 ， 就 不 会 有 上 述 麻烦 。 

自 定义 函数 AddQuote 的 作用 是 给 路 径 两 侧 加 上 双 引 号 ， 并 且 添 补 一 个 空格 ， 以 防止 连 
在 一 起 。 

Private Function AddQuote (Path As String) Rs String 


AddQuote = Chr(34) & path & Chr(34) & " " 
End Function 
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Sub 处 理 空格 () 
Dim exepath Rs String, param As String 
exepath = "C:\Program Files\Microsoft Office\Officel5\WINWORD.EXE" 


param = "C:\temp\ 公 务 员 .docx" 

exepath = AddQuote (exepath) 

param = AddQuote (param) 

Shell exepath & param, vbNormalFocus 
End sub 


运行 上 面 的 “处 理 空格 ”过 程 ， 该 文档 可 以 正常 地 在 Word 中 打开 。 


2.1.5 ”自动 打开 控制 面板 
控制 面板 的 主 文件 是 位 于 System32 文件 夹 下 的 controlexe， 因 此 只 需要 执行 : 


Shell "control.exe", vbNormalFocus 


就 可 以 打开 控制 面板 的 主页 ， 如 图 2-7 所 示 。 
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图 2-7 自动 打开 控制 面板 
如 果 要 直接 打开 控制 面板 中 特定 的 一 项 ， 需 要 添加 命令 参数 。 


Shell "control .exe appwiz.cpl", vbNormalFocus 


上 述 代 码 表 示 直 接 打开 控制 面板 中 的 “ 印 载 程序 ”命令 参数 appwiz.cpl 是 Application 
Wizard 的 缩写 ,意思 是 程序 向 导 ， 如 图 2-8 所 示 。 

因此 ， 只 需要 把 Shell 函数 命令 参数 中 的 cpl 文件 更 改 一 下 ， 就 可 以 打开 控制 面板 中 的 
其 他 各 项 。 常 用 的 有 如 下 这 些 。 

御 载 程序 : Shell "Control.exe " & "appwiz.cpl", vbMaximizedFocus 

显示 属性 : Shell "Control.exe " & "desk.cpl", vbMaximizedFocus 

浏览 器 属性 : Shell "Control.exe " & "inetcpl.cpl", vbMaximizedFocus 


区 域 和 语言 
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图 2-8 控制 面板 中 的 项 目 


: Shell "Control.exe " & "intl.cpl", vbMaximizedFocus 


声音 和 音频 : 


Shell "Control.exe " & "mmsys.cpl", vbMaximizedFocus 


网 络 连接 : Shell "Control.exe " & "ncpa.cpl", vbMaximizedFocus 

用 户 账户 : Shell "Control.exe " & "nusrmgr.cpl", vbMaximizedFocus 
电源 选项 : Shell "Control.exe " & "powercfg.cpl", vbMaximizedFocus 
计算 机 属性 : Shell "Control.exe " & "sysdm.cpl", vbMaximizedFocus 
日 期 和 时 间 : Shell "Control.exe " & "timedate.cpl", vbMaximizedFocus 
安全 中 心 : Shell "Control.exe " & "wscui.cpl", vbMaximizedFocus 


2.1.6 ”打开 资源 管理 器 


资源 管理 器 是 以 树 状 结构 显示 计算 机 中 的 文件 系统 的 窗口 ， 在 Windows XP 系统 中 双击 


资源 管理 器 的 主 文件 为 explorer.exe。 
在 实际 编程 中 ， 经 常用 到 自动 打开 某 个 文件 来， 或 者 自动 选中 文件 、 文 件 夹 的 操作 。 如 


下 面 的 代码 。 


“我 的 电脑 "， 在 Windows 7 系统 中 双击 “计算 机 ”， 或 者 按 下 快捷 键 【 Windows + EE ]， 都 可 
以 打开 资源 管理 器 。 


Shell "explorer.exe C:\temp\ 成 绩 表 .pdf"，vbNormalFocus 


上 述 代码 表示 用 系统 默认 程序 打开 指定 的 PDF 文件 ， 这 相当 于 用 鼠标 双击 了 计算 机 中 


Shell "explorer.exe C:\temp\", vbNormalFocus 


上 述 代码 表示 打开 temp 文件 夹 ， 相 当 于 用 鼠标 双击 了 该 文件 来 ， 进 入 该 文件 夹 内 部 。 
针对 以 上 两 句 代码 ， 如 果 添 加 参数 “/select,”， 那 么 不 是 打开 文件 或 文件 夹 ， 而 是 选中 。 


Shell "explorer.exe /select，C:\temp\ 成 绩 表 .pdf"，vbNormalFocus 


上 述 代 码 表示 显示 资源 管理 器 ， 并 自动 选中 文件 ， 如 图 2-9 所 示 。 


的 “成 绩 表 .pdf ”文件 ， 如 果 计 算 机 中 安装 的 是 Adobe Acrobat， 那 么 用 该 软件 打开 PDF 文 
件 。 对 于 其 他 扩展 名 的 文件 也 是 如 此 ， 因 此 这 个 代码 实用 价值 很 高 。 
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全 于 全 中 Dj -2012- 
国 视 机 日 告 11-GFCL2012-3- 中 文 pdf PDF 文件 再 | 
国 图 片 65.png PNG 必 浆 2 
国 丽 abclLpng PNG 图像 2 
站 国 PythonLogo.png PNG 图 从 | 
RT [Bpyinstallpy Python File x | 
中 二 乐 BB python2.py Python File 2 
忆 simplehttpserver2.py Python File 2d 
网 永 降 组 [2 simplehttpserver3.py Python File 5 | 
[2 ThinterGrid-Menu-SendMailpy Python File 20= 
0 PT | » 
成绩 表 .pdf 修改 日 期: 2017/6/25 7:58 创建 日 内 : 2017/6/25 7:58 
区 | PDF 文件 大 js 128 KB 
全 = 了 


图 2-9 在 资源 管理 器 中 自动 选中 文件 


Shell "explorer.exe /select, C:\temp\", vbNormalFocus 


上 述 代 码 表示 自动 选中 temp 文件 夹 ， 而 不 打开 。 
此 外 ， 利 用 explorer 还 可 以 自动 打开 指定 url 的 网 页 。 


Shell "explorer.exe http://vba.mahoupao.net/forum.php", vbNormalFocus 


上 述 代码 会 用 计算 机 默认 的 网 页 浏览 器 打开 一 个 论坛 。 


2.1.7 注册 ocx 文件 和 dll 文件 


ocx 文件 是 指 对 象 类 别 扩充 组 件 。 计 算 机 中 扩展 名 为 .ocx 的 文件 ,不 能 直接 双击 
执行 ， 一 般 要 把 ocx 控件 插入 到 窗 体 中 使 用 。 例 如 在 VBA 的 UserFomm 中 ， 可 以 插 人 
CommonDialog 、DataGrid 这 些 ActiveX 控件 ， 如 图 2-10 所 示 。 


(| 内 国 接 件 Ativex2 | 
| 更 口 台 人 豆 


加 Micosof ADO Data Control verson 6D (C ~ 
日 


EJ 
I Microsoft DataGrid Control Version 6.0 (O| 取消 


9 Microsoft Date and Time Picker Control 


[a Microsoft progressBar Control version 60 


中 Im wicoso Rh Todbox Controi69 (SP4) 
| Micosof statasbar Control, version G0 
| | igosof Tabbed Dialog Cantrol versiont [显示 
NserTorai soriom 可 | 日 Microsoft Tabstrip Control, versicn 60 ~ | 反 内 量 示 所 沈 项 ($) 
Ti 
序 | 按 分 类 序 | 


汪 吾 CNRibbonXMLEditor\COMDLG32.OCX 


这 Dialog Contral version 6.0- 


2-10 用 户 窗 体 中 使 用 ocx 控件 
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这 些 ocx 文件 大 多 数 是 微软 公司 开发 的 性 能 优良 的 控件 ， 插 入 到 窗 体 后 ， 可 以 让 编程 更 
加 简单 ， 界 面 更 加 专业 、 美 观 。 

此 外 ， 用 户 根 据 需 要 也 可 以 自己 制作 专用 的 ocx 控件 。 但 是 ，ocx 的 移植 ， 也 就 是 说 从 
一 台 计 算 机 把 ocx 控件 复制 到 另 一 台 计 算 机 ， 是 不 能 直接 使 用 的 ， 必 须 在 目标 计算 机 上 注 
册 。 因 为 未 注册 的 ocx 控件 不 会 显示 在 “附加 控件 ”对 话 框 中 ， 也 就 无 法 装 和 人 窗 体 。 所 谓 注 
册 ， 就 是 为 该 控件 分 配 一 个 GUID， 并 保存 于 注册 表 中 。 反 注册 ， 就 是 从 注册 表 中 移 除 该 控 
件 的 有 关 信 息 ， 使 其 无 法 在 编程 环境 中 访问 。 

注册 和 反 注 册 文件 ， 可 以 用 Shell 函数 调用 System32 文件 夹 下 的 regsvr32.exe 文件 实现 。 

注册 ocx 文件 的 语法 格式 如 下 。 


Shell "regsvr32.exe ocx 文 件 的 路 径 " 
下 面 尝试 注册 一 款 笔者 开发 的 TreeviewExplorerocx 控件 ， 并 在 VBA 中 运行 。 
Shell "regsvr32.exe E:\TreeviewExplorer\TreeviewExplorer.ocx" 


执行 上 述 过 程 会 弹出 注册 成 功 的 提示 框 ， 如 图 2-11 所 示 。 
如 果 要 屏蔽 注册 成 功 的 对 话 框 ， 可 以 在 regsvr32. | Reesvaz 


exe 后 面 添加 /s 参数 ， 也 就 是 改 为 如 下 形式 。 DllRegisterServer 在 


Ei\TreeviewExplorer\TreeviewExplorer.ocx 已 成 


Shell "regsvr32.exe /s E:\TreeviewExplorer\ 


TreeviewExplorer.ocx" 
那么 ， 注 册 成 功 后 ， 到 底 引 起 了 哪些 变化 呢 ? 


运 行 Shell "regedt32.exe" ,vbNormalFocus, 
自动 打开 注册 表 编 辑 器 ， 在 查找 对 话 框 中 输入 关键 字 ， 可 以 快速 找到 该 控件 的 注册 信息 ， 如 
图 2-12 所 示 。 


图 2-11 成 功 注册 ocx 控件 
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图 2-12 ocx 控件 的 信息 写 人 注册 表 


可 以 看 出 注册 信息 位 于 : HKEY _ CLASSES ROOTWVTreeviewExplorerUC。 

注册 成 功 的 控件 ， 更 重要 的 变化 在 于 能 够 在 各 种 窗 体 中 使 用 该 控件 。 下 面 是 VBA 的 用 
户 窗 体 中 的 “附加 控件 ”对 话 框 ， 在 该 项 前 面 勾 选 ， 即 可 把 自 定义 控件 添加 到 “控件 工具 箱 ” 
中 ， 从 而 可 以 插入 窗 体 中 ， 如 图 2-13 所 示 。 
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Rat 人 入 
可 用 控件 (A): 
[D sysColorctl class 3 
System Monitor Contral 


上 口 VFDvCombo 控件 
ID VideoRenderCt Class 


位 置 ENTreeviewExplorerVTreeviewExplorerocx | 


图 2-13 使 用 自 定义 控件 
控件 的 反 注册 也 很 简单 ， 只 需要 在 上 述 注册 的 代码 中 插入 一 个 参数， 就 是 反 注册 。 
Shell "regsvr32.exe /u E:\TreeviewExplorer\TreeviewExplorer.ocx" 
如 果 不 弹出 提示 对 话 框 ， 更 改 为 如 下 代码 。 
Shell "regsvr32.exe /s /u E:\TreeviewExplorer\TreeviewExplorer.ocx" 


控件 被 反 注 册 以 后 ， 注 册 表 中 会 删除 该 控件 的 信息 ， 在 “附加 控件 ”对 话 框 中 也 找 不 到 
该 控件 。 

dl 文件 ， 即 动态 链接 库 文件 (Dynamic Link Library)， 也 可 以 称 为 类 库 ， 与 ocx 文件 一 
样 ， 不 能 直接 运行 。dll 文件 中 主要 封装 了 一 些 函数 和 代码 。Of8ce 的 COM 加 载 项 就 是 一 种 
扩展 名 为 .dll 的 文件 。 

在 VBA 编程 中 ， 可 以 向 VBA 工程 的 引用 中 添加 dl 文件 ， 从 而 使 用 dl 文件 中 的 功能 
和 函数 。 

dl 文件 的 注册 、 反 注册 方法 和 ocx 的 代码 是 一 模 一 样 的 ， 只 需要 把 ocx 控件 的 路 径 更 
改 为 dl 文件 的 路 径 即 可 。 

OfficeDll 是 笔者 开发 的 一 款 功 能 丰富 的 动态 链接 库 ， 把 该 文件 复制 到 目标 计算 机 后 ， 
运行 下 面 的 代码 进行 注册 。 

Shell "regsvr32.exe E:\OofficeD11\OfficeD11.dl1" 

注册 成 功 后 ， 单 击 VBA 编辑 器 的 菜单 【工具 /引用 ]， 在 “可 使 用 的 引用 ”列表 中 可 以 
看 到 该 动态 链接 库 ， 如 图 2-14 所 示 。 

添加 引用 成 功 后 ， 编 写 代 码 ， 可 以 看 到 该 类 库 的 成 员 列 表 ， 如 图 2-15 所 示 。 

注意 ， 如 果 同 一 台 计 算 机 中 存在 多 个 同名 ocx 或 dl 文件 ， 以 最 近 注册 的 为 准 。 

注册 和 反 注 册 的 方法 总 结 如 下 。 

Shell "regsvr32.exe 文件 " 表示 注册 一 个 文件 ， 并 弹出 提示 对 话 框 。 

Shell "regsvr32.exe /s 文件 " 表示 注册 一 个 文件 ,不 弹出 提示 对 话 框 。 

Shell "regsvr32.exe 岂 文件 "表示 取消 注册 一 个 文件 ， 并 弹出 提示 对 话 框 。 

Shell "regsvr32.exe 4s 几 文件 " 表示 取消 注册 一 个 文件 ， 不 弹出 提示 对 话 框 。 
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引用 - VBAProject LD 
可 使 用 的 引用 (A); | 
取 闪 
ME [ 鲁 ) 可 Fest 
区 加 | Sub Test() 
优先 级 Dim 0 As New OfficeD11.ClsAPI 
者 助 With 0 
站 OPtoPil 1 0 Type Library al -About Application. Hwnd, “hello”, “vba” 
DOL Services driver interfaces 
DoLAp Services Lock Nanager 加 
rap ors ees Wowort Tranoe 
1 
OfficeDll 
| 定位 : ee ceDll. dl 
图 2-14 动态 链接 库 的 注册 和 使 用 图 2-15 VBA 中 使 用 动态 链接 库 


关于 ocx 控件 和 动态 链接 库 的 开发 和 应 用 ， 本 书 暂 不 讨论 。 
2.1.8 ”结束 进程 


在 Windows 系统 中 按 下 快捷 键 【 Ctrl+ShifttEsc 】 可 以 弹出 Windows 任务 管理 器 ， 通 过 
Windows 任务 管理 器 可 以 强行 结束 一 个 进程 ， 如 图 2-16 所 示 。 


i 
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图 2-16 Windows 任务 管理 器 


假定 现在 屏幕 上 打开 了 计算 器 ， 进 程 列表 中 一 定 有 calc.exe 进程 ， 然 后 在 VBA 中 运行 
如 下 代码 。 


Shell "taskkill /f /im calc.exe", vbHide 


可 以 看 到 计算 器 自动 被 终止 。taskkill.exe 也 是 System32 文件 夹 下 的 一 个 可 执行 文件 ， 
专门 用 来 终止 进程 


2.1.9 自动 关机 


shutdown.exe 是 一 个 用 于 关机 的 系统 文件 ， 用 Shell 函数 调用 shutdown 可 以 实现 自动 关 


外 Office VBA 开发 经 典 一 一 中 级 进 阶 郑 


机 、 取 消 关机 、 自 动 重启 等 操作 。 


Sub Test1() 

Shell "shutdown -s", vbNormalFocus ' 一 分 钟 后 关机 
End sub 
Sub Test2() 

Shell "shutdown -r", vbNormalFocus " 一 分 钟 后 重启 
End Sub 
Sub Test3() 

Shell "shutdown -a", vbNormalFocus "取消 计划 
End Sub 


运行 上 述 Testl 或 Test2 ， 会 弹出 提示 框 ， 如 图 2-17 所 示 。 
如 果 又 不 想 关 机 或 重启 ， 那 么 需要 运行 Test3 取消 计划 。 计 划 被 取消 时 ， 屏 幕 右 下 角 弹 
出 提示 ， 如 图 2-18 所 示 。 


全 您 术 要 被 注销 D3 
外 Windows 将 在 一 分 钟 内 关闭 。 各 注销 被 取消 x 
计划 的 关闭 已 取消 。 
:1 
图 2-17 计划 关机 图 2-18 取消 计划 


在 日 常 办 公 中 ， 一 台 计 算 机 经 常会 连续 工作 好 几 天 ， 此 时 ， 可 以 用 Excel VBA 设置 一 
个 计划 ， 在 未 来 某 一 天 的 某 一 时 刻 定时 关机 。 

Application 对 象 的 OnTime 方 法 可 以 在 某 一 时 刻 准 时 执行 某 个 过 程 ， 因 此 ， 运 行 下 
面 的 MySchedule 过 程 ， 计 算 机 不 会 发 生 任 何 变化 ,但 是 到 了 指定 的 时 刻 ， 会 准时 调用 
AutoShutdown 过 程 ， 从 而 实现 自动 关机 。 

Sub RARutoShutdown () 

Shell "shutdown -s", vbNormalFocus ' 一 分 钟 后 关机 

End Sub 

Sub MySchedule () 


Application.OnTime #12/21/2017 11:11:00 AM#, "AutoSshutdown" 
End Sub 


注意 运行 MySchedule 过 程 后 ，Excel 要 一 直 保 持 打开 状态 ， 如 果 退 出 Excel， 计 划 
无 效 。 


以 上 内 容 的 源 代码 文件 为 “实例 文档 06.xlsm”。 


2.2 ”内置 注 册 表 畏 数 


注册 表 是 Windows 系统 中 的 一 个 系统 数据 库 ， 主 要 存储 硬件 配置 、 软 件 设置 等 信息 。 
注册 表 的 操作 主要 有 创建 注册 表 项 、 删 除 注册 表 项 、 修 改 注册 表 项 、 读 取 注 册 表 项 等 。 
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在 实际 编程 过 程 中 ， 可 以 把 开发 的 程序 中 的 一 些 变量 的 值 存储 在 注册 表 中 ， 也 可 以 从 注 
册 表 中 读 取 内 容 ， 让 程序 加 以 利用 。 因 此 注册 表 操 作 很 有 必 要 学 习 和 研究 。 
VBA 操作 注册 表 的 方式 有 多 种 ， 本 节 介 绍 VBA、VB6 的 几 个 内 置 函 数 。 


口 GetSetting: 根据 指定 的 路 径 获取 注册 表 项 的 值 。 
口 GetSettings: 与 GetSetting 类 似 ,返回 一 


口 SaveSetting: 保存 内 容 到 注册 表 中 。 
口 DeleteSetting: 删除 一 个 注册 表 项 。 
需要 注意 的 是 ， 上 述 4 个 内 置 函 数 的 操作 范围 只 限于 HKEY_CURRENT _USER\ 
Software\VB and VBA Program Setting 这 个 键 值 内 部 。 
按 下 快捷 键 【 Windows +R ]， 输 入 regedit， 按 回 车 键 即 可 弹出 注册 表 编 辑 器 。 然 后 依 
次 单 击 节点 HKEY_CURRENT USER\Software\VB and VBA Program Setting， 就 可 以 进入 该 


文件 夹 中 ， 如 图 2-19 所 示 。 
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图 2-19 VB、VBA 专用 的 注册 表 项 


以 上 四 个 内 置 函 数 的 参数 几乎 都 包含 AppName 、Section、Key 三 个 层级 。 
以 图 中 所 选 的 节点 为 例 , AppName、Section、Key 依次 是 CnChessQipu、DataBase、 


FileName。 


2.2.1 GetSetting 


GetSetting 的 作用 是 从 指定 的 层级 获取 Key 的 属性 值 ， 返 回 一 个 字符 串 。 


Sub ReadKey () 
Dim V As String 


V = GetSetting (AppName:="CnChessQipu", Section:="DataBase", Key:= "FileName") 


MsgBox Vv 
End sub 


运行 上 述 过 程 ， 对 话 框 中 返回 注册 表 中 FileName 的 属性 值 ， 如 图 2-20 所 示 。 
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与 注册 表 中 对 比 ， 完 全 一 致 ， 如 图 2-21 所 示 。 


Microsoft Excel 后 字 行 朱 
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图 2-20 获取 注册 表 信 息 图 2-21 核对 获取 的 结果 


需要 注意 的 是 ， 如 果 GetSetting 函数 的 三 个 参数 中 的 任何 一 个 写 错 ， 都 将 造成 找 不 到 注 
册 表 项 ， 不 会 出 现 运行 错误 ,而 是 返回 一 个 空 字符 串 。 


2.2.2 SaveSetting 


在 使 用 SaveSetting 函数 的 过 程 中 ， 如 果 指 定 的 层级 存在 ， 就 修改 现 有 层级 的 属性 值 ; 
如 果 层 级 不 存在 ， 则 会 自动 创建 层级 路 径 。 
SaveSetting 是 对 注册 表 的 修改 ， 没 有 返回 值 ， 因 此 后 面 的 参数 不 需要 括号 。 
运行 下 面 的 过 程 ， 修 改 FileName 这 个 Key 的 属性 值 。 
Sub ModifyKey() 
Dim v As String 
V = "C:\temp\2018.mde" 
SaveSetting AppName:="CnChessQipu", Section:="DataBase", Key:="FileName", 


Setting:=V 
End Sub 


刷新 一 下 注册 表 ， 看 到 属性 值 已 修改 ， 如 图 2-22 所 示 。 


0°- Telerik 5) REG_SZ (数值 未 设置 ) 

0 击 Tencent 国 FleName REG_SZ C\temp\2018.mde 

» -有 Thunder Network | 
是 Trolkech 

小 umIULAB 

4 有 VB and VBA Program Settings 


|B Database| 国 | 
B Effects ~ 
Fi | 


计算 机 \HKEY_CURRENT_USER\Software\VB and VBA program Settings\CnChessQipu\Database 
图 2-22 修改 注册 表 信息 


在 编程 开发 过 程 中 ， 经 常 需要 在 一 个 Section 下 面 建立 多 个 Key， 此 时 会 对 应 多 个 属性 
值 。 下 面 以 世界 各 国信 息 为 例 ， 说 明 一 下 注册 表 项 的 存 取 过 程 ， 如 表 2-3 所 示 。 
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表 2-3 世界 各 国 基本 信息 表 


家 国土 面积 / 万 平方 公里 人 口 / 亿 
中 国 960 13.75 
美 3.231 
俄罗斯 1.443 
加 拿 大 0.3628 


假设 要 把 表 2-3 中 的 内 容 保存 到 注册 表 中 ,那么 “国家 ”这 一 列 就 相当 了 
积 和 人 口 都 是 Key， 要 分 别 保存 。 以 上 所 有 项 目 都 位 于 “世界 大 国 ” 这 个 


首都 、 国 土 画 
AppName 下 面 。 


Sub SaveKey () 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 
SaveSetting 

End Sub 


"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 
"世界 大 国 " 


了 
’ 
8 
’ 
’ 
’ 
’ 
’ 
了 
’ 


"中 国 "，" 首都 "，" 北京" 

"中 国 "，" 国土 面积 "，"960" 
"让 国 马 "人 33758 
"美国 "，" 首都 "，" 华盛顿 " 
"美国 "，" 国土 面积 "，"962" 
3 


"俄罗斯 "，" 首都 "，" 莫斯科 " 
"俄罗斯 "，" 国土 面积 "，"1709" 
“= 俐 罗 斯 “人 3" 

"加 拿 大 "，" 首都 "，" 温 太 华 " 
" 加拿大 "，" 国土 面积 "，"998" 
和 


F Section， 而 


运行 上 述 过 程 ， 刷 新 注册 表 ， 可 以 看 到 注册 表 中 已 存在 相关 信息 ， 如 图 2-23 所 示 。 


旷 注 2 Wi ET 


文件 (前 ” 蝙 罚 (E) 查看 (V) 收藏 天 (A) 帮助 (H) 


| 

| Bi CountDown-Day 
| 有 ExcelComAddin 
| 

| 


J Ipconfg 


I B mp3player 
| J OfficeFavorite 
| J ParentpythonWindow 
| 上 PyinstallerHelper 
J RegisterDemo 
| BD SendMail 
J TexFriend 


是 veE2014 
B Visual Tkinter 

且 VisualstudioAddin2016 
B xQwizard 


J ExcelRangeTransformation 


J Microsof Visual Basic Addins 


-站 Trolhech EE 3 E33 
bp-B unune 加 (AN REG_SZ 数值 未 设置) 
4 小 ve and vBA Program Settings 网 国土 硬 有 Ea dex 
er 3 人口 REGSZ 3231 
eg A REGSZ 四 
B CnChess 
CnChessQipu 
Bi CountDown 


国 | 


| 加 a) » 


计算 机 \HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ 世 界 大 司 \ 美 国 


图 2-23 批量 存 人 注册 表 


乓 office VBA 开发 经 典 一 中 级 进 阶 郑 


2.2.3 DeleteSetting 


DeleteSetting 用 于 删除 一 个 注册 表 节 点 ， 这 里 的 节点 可 以 是 AppName、Section 、Key 
中 的 任何 一 个 。 

DeleteSetting 需要 指定 的 参数 也 是 三 个 ， 但 是 根据 需要 ， 可 以 更 改 参 数 个 数 。 规 定 的 参 
数 越 少 ， 删 除 的 层级 越 高 ， 删 除 的 内 容 也 越 多 。 


DeleteSetting " 世界 大 国 "，" 加 拿 大 "， " 国土 面积 " 


表示 删除 加 拿 大 的 国土 面积 这 个 Key 和 属性 。 

DeleteSetting "世界 大 国 "，" 加拿大 " 

表示 删除 加 拿 大 这 个 Section， 也 就 是 删除 加 拿 大 这 个 文件 夹 。 
DeleteSetting "世界 大 国 " 


将 会 删除 整个 AppName 根 节点 。 
2.2.4 GetAllSettings 


获取 注册 表 的 方法 ， 除 了 前 面 讲 过 的 GetSetting 函数 以 外 ， 还 可 以 用 GetAllSettings 函 
数 一 次 性 获取 一 个 Section 下 面 的 所 有 Key 及 其 属性 值 。 获 取 到 的 内 容 是 一 个 多 行 2 列 的 二 
维 数组 。 

下 面 的 代码 把 “中 国 ” 这 个 Section 的 所 有 属性 装载 到 字符 串 数 组 vO 中 。 


Sub ReadAllKeys() 
Dim v() Rs String 
V = GetAllSettings (AppName:=" 世界 大 国 "，Section:=" 中 国 ") 
Range ("Al1") .Resize (UBound(v, 1) + 1, 2).Value = Vv 

End Sub 


单 步 执行 上 述 过 程 ， 可 以 在 本 地 窗口 看 到 v0 是 一 个 3 行 2 列 的 二 维 数组 ， 如 图 2-24 所 示 。 


Sub ReadAllKeys() 
Dim v() As String 
Vv = GetAllSettings (AppName:=” 世 界 大 国 ”，Section:=” 中 国 ) 
Range (“Al”). Resize (UBound(v, 1) + 1, 2).Value = v 

End Sub 


Be 
ER A Ee 
图 2-24 一 次 性 获取 全 部 注册 表 信息 
为 了 把 数组 放 到 Excel 单元 格 中 ， 采 用 Range 的 Resize 方法 根据 数组 大 小 自动 扩展 区 域 。 


运行 上 述 过 程 后 ， 表 格 单元 格 的 结果 如 图 2-25 所 示 。 

以 上 内 容 的 源 代码 文件 为 “实例 文档 07.xlsm”。 

以 上 四 个 注册 表 操 作 函 数 一 般 用 于 产品 开发 时 存 取 
程序 信息 ， 如 果 要 操作 其 他 场所 的 注册 表 项 ， 需 要 用 到 
2.3 节 讲述 的 WshShell 对 象 。 


2.3 使 用 WshSshell 操作 注册 表 


WshShell 对 象 可 以 运行 程序 、 操 作 注册 表 、 创 建 快捷 方式 、 访 问 系统 文件 夹 、 管 理 环 


境 变量 等 。 
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&1 


d B | 
T Er 时 b 京 
2 | 国土 面积 960 


3_ | 人口 13.75 


图 2-25 将 注册 表 信息 发 送 到 单元 格 


要 在 VBA 中 使 用 该 对 象 ， 需 要 向 工程 添加 外 部 引用 “ Windows Script Host Object 


Model”， 如 图 2-26 所 示 。 


代码 中 声明 为 : 


引用 -VBAProjet 
可 使 用 的 引用 ON) 
取消 
浏览 中 


fl 
SCpLAdnin 1.0 Type Lib 
et 1.0 Type Library 优先 级 


0 Type Library + 
Ei 二 | 
1.0 Type Library 
ae 1.0 Type Librar' 。 

wza_TP_Tno1her/Pawny 


帮助 00 


Windows Script Host Object Model 
定位 C:\Windows\systen32\wshon. ocx 


语言 标准 


图 2-26 添加 外 部 引用 


Dim WS As New IWshRuntimeLibrary.WshShell 


后 期 绑 定 方式 为 : 


Set WS = CreateObject ("WScript.Shell") 


WshShell 对 象 中 ， 用 于 操作 注册 表 的 函数 有 如 下 三 个 。 


2.3.1 


口 RegRead: 读 注册 表 项 。 
口 RegWrite: 写 注册 表 项 。 
口 RegDelete: 删除 注册 表 项 。 


读 注册 表 项 


在 使 用 RegRead 函数 时 ， 只 需要 一 个 注册 表 项 的 完整 路 径 即 可 返回 注册 表 值 。 
Excel 2013 的 宏 安 全 性 设置 其 实 是 保存 在 注册 表 中 的 ,通过 查看 注册 表 编辑 器 ， 按 照 如 


下 路 径 可 以 找到 Security 节点 ， 如 图 2-27 所 示 。 


例 office VBA 开发 经 典 一 中 级 进 阶 郑 


HKEY CURRENT USER\Software\Microsoft\Office\15.0\Excel\Security 


ES —* ” - -ss ,=| 加 | 坚 | 
文件 月 ”篇 加 (日 ”过 看 V) 收 闪 (A) 才 动 (H) 

5 MSDTS EE ee E23 

看 MsF El SY REG SZ 修 信 未 设 寺 ) 

5 Mulimedia 一 AccessVBOM REG DWORD Ox00000000 (0) 


3 pe 到 vBAwamings REG DWORD 0x00000001 (1) 


? 国 1 
? 国 14o 
4 加 150 
-下 Access 
5- 量 Common 
Excel 
B Add-in Manager 


加 十 六 进 抽 00 
B AddintoadTimes 和 2 
,RU ED ED 
出 options 
5 及 Place MRU 
DB Recent Templates 
5 Resiiency 


“点 Security 

| 出 protectedview 
| -出 Trusted Documents 

| | ? 蝎 Tmusted Locations 

且 statusBar 

| »- 有 Web Extension MRU 国 

| | 一 FirstRun 

I ee Te | GO 

计算 WN IKCY_CURRENT_USCR\Software\Microsof\ Office\15.0\CxceNSecurity 


图 2-27 注册 表 信息 

可 以 看 到 下 面 有 一 个 Key 为 VBAWarnings，Key 的 取 值 对 应 于 Excel 宏 安 全 性 的 设置 
(从 上 到 下 的 4 个 单 选 按钮 对 应 的 属性 值 依次 是 4、2、3、1 )， 如 图 2-28 所 示 。 

aw -SG 


4 ” 轩 人 村 用 所 有 产 ,并 且 不 通知 (U 

2 个 要 用 所 有 去 , 并 发 出 通 XD) 

3 日 条 用 无 字符 村 的 所 有 去 (G) 

1 加 启用 所 有 去 (不 闪 逢 ; 可 能 会 运行 有 潜在 过 的 代 R)(E) 
下 


园 信任 对 VBA 工程 对 拿 模 至 的 访问 (W 


图 2-28 VBA 安全 性 级 别 与 注册 表 的 对 应 关系 


也 就 是 说 ， 手 工 在 Excel 中 修改 了 宏 安 全 性 级 别 ， 注 册 表 会 同步 变化 ; 反之 ,通过 注册 
表 修改 VBAWarnings 的 属性 值 ，Excel 的 宏 安全 性 也 同步 发 生变 化 。 
下 面 的 代码 用 来 判断 当前 Excel 的 宏 安全 性 。 


Sub Testl1() 
Dim WS As New IWshRuntimeLibrary.WshShell 
With WS 
MsgBox .RegRead ("HKEY CURRENT USER\Software\Microsoft\Office\15.0\Excel\ 
Security\VBAWarnings") 
End With 
End Sub 
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以 上 代码 运行 后 ， 返 回 一 个 十 进 制 数 1， 表 示 “ 启 用 所 有 宏 ”。 


注意 ”如果 RegRead 函数 中 的 注册 表 路 径 不 存在 ， 则 会 弹出 “自动 化 " 错误 ， 如 图 2-29 所 示 。 


为 了 确保 注册 表 路 径 书 写 不 出 问题 ， 可 以 在 注册 表 编 辑 器 中 右 击 节点 ， 在 弹出 菜单 中 选 
择 “ 复 制 项 名 称 ” 命 令 ， 可 以 把 完整 路 径 复制 到 剪贴 板 ， 如 图 2-30 所 示 。 


县 MsF 
» 是 Mukimedia 
县 Notepad 
“地 ofiq sm 
” 生 1 新建 IN) + 
hl en.. 
pi | 
> sD) 
? | 重 名 名 (R) 
1 SS 
权限 


有 Place MRU 
Bl Recent Templates 
上 Resiliency 
4 Securty 
上 ProtectedView 
-Trusted Documents 
下 Trusted Locations 


Microsoft Visual Basic 
0 


运行 时 描 误 “-2147024694 (B0070002) 
自动 化 (katomation) 错误 


Bi StatusBar 
> Web Extension MRU 国 


BFirstRun : 
4. 是 » 


继续 口 | 结束 @@) 帮助 名 
图 2-29 注册 表 路 径 不 存在 引起 的 错误 图 2-30 复制 项 名 称 


2.3.2” 写 注册 表 项 


与 RegRead 函数 相对 应 的 是 RegWrite 方法 ， 该 方法 用 于 修改 注册 表 的 值 。 
RegWrite 方法 包含 以 下 3 个 参数 。 
口 Name: 注册 表 的 路 径 字符 串 。 
口 Value: 要 设 定 的 值 。 
口 Type: 注册 表 项 的 类 型 ， 可 以 是 REG_SZ (字符 串 值 )、 REG DWORD(DWORD 32 位 置 )、 
REG BINARY (二 进 制 值 )。 
下 面 的 过 程 ， 通 过 改变 注册 表 值 ， 自 动 修改 Excel 2013 的 宏 安 全 性 为 “禁用 所 有 宏 ， 并 
Sub Test2() 
Dim WS As New IWshRuntimeLibrary.WshShell 


With WS 
-RegWrite Name:="HKEY CURRENT USER\Software\Microsoft\Office\15.0\Excel\ 


Security\VBAWarnings", Value:=2, Type:="REG DWORD" 


人 例 ”office VBA 开发 经 典 一 中 级 进 阶 郑 


End With 
End sub 


代码 分 析 : 根据 注册 表 编 辑 器 ， 可 以 看 到 该 注册 表 项 的 类 型 是 一 个 DWORD 值 ， 因 此 
Type 参数 设置 为 “REG DWORD”。 


2.3.3 ”删除 注册 表 项 


RegDelete 方法 的 语法 非常 简单 ， 只 需要 规定 注册 表 项 的 路 径 即 可 。 
下 面 的 代码 删除 注册 表 中 的 Key VBAWarnings。 


Sub Test3() 
Dim WS As New IWshRuntimeLibrary.WshShell 
With WS 
.RegDelete "HKEY CURRENT USER\Software\Microsoft\Office\15.0\Excel\Security\ 
VBAWarnings" 
End With 
End Sub 


实际 上 ， 注 册 表 和 资源 管理 器 类 似 ， 也 是 一 个 树 状 结构 ， 严 格 地 讲 ，RegDelete 方法 不 
仅 可 以 删除 Key， 还 可 以 删除 各 层级 的 文件 夹 。 也 就 是 说 : 


RegDelete "HKEY CURRENT USER\Software\Microsoft\Office\15.0\Excel\Security\" 


理论 上 可 以 删除 Security 整个 文件 夹 ， 但 微软 不 允许 用 户 删除 ， 因 此 运行 时 可 能 会 出 错 。 

最 后 演示 一 个 用 代码 自动 读 取 、 设 置 记事 本 的 字体 名 称 。Notepad 是 Windows 系统 的 默 
认 程 序 ， 属 于 微软 开发 的 产品 。 在 注册 表 中 查看 该 节点 ， 可 以 看 到 右 侧 有 大 量 的 Key， 这 些 
其 实 就 是 记事 本 的 配置 信息 ， 如 图 2-31 所 示 。 


| 


| 六 D 忽 久 (EF) 查看， 必 大 夫人 A) 大 动 (HM) 


0 六 Ms Setup [ACME) “| 2 E77] EE 


Db- 关 MSDAIPP 2 (RA) REG SZ (下 时 未 设 置 
>- 雷 MSDN 足 fwrap REG_DWORD Ox00000001 (1) 
i 全 ipcintSize REG DWORD 。。 0x0000008c (140) 
[和 器 WndowPosDx REG.DWORD C0x00000345 (837) 
? 调 Mulimedie 左 wndowpospy REG.DWORD Ow0000228 (557) 
一 一 一 一 付 Wndowrosx REG_DWORD 0x0000011a (282) 
柄 Wondowpoav REG_DWORD 。。 ou00000042 (66) 


?是 OLE/COM Object Interface 


;前 OLEJCOM Obiject Viewer | 台 !fcharset REG_DWORD Ox00000000 (0) 
Fi 刁 Wcipprecsion REG.DWORD 0x00000002 四 
The 三 Escepement REG_DWORD 0x00000000 (0) I 
Protected Storage System EE reosz ak | 
D -前 RAS AutoDial ET REG_DWORD Ox00000000 (0) 
WD RAS phonebook REG_DWORD 0x00000000 (0) 
BD Remote Assistance REG_DWORD 0x00000003 (3) 
县 Shared REG_DWORD 0x00000002 (2) 
5- 有 Shared Tools REG_DWORD Ox00000001 (1 
Sdechow REG_DWORD ox00000000 四 
Bi seo REG_DWORD 0x00000000 (0) | 
上 -县 Spesch REG_DWORD Ox00000190 (400) 
了 温 SQMClent REG_DWORD Ox00000000 (0) 


» Bl SystemCerificates 
» BTipShared - 


ee | 3 
| 计 乱 NHKEY_CURRENT_USER\Software\Mcrosof\Notcpad 

图 2-31 记事 本 程序 的 注册 表 信息 
可 以 看 到 字体 名 称 的 Key 是 FaceName， 这 是 一 个 REG SZ 字符 串 ， 当 前 字体 为 “宋体 ”。 
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下 面 的 过 程 首 先 读 取 记事 本 程序 的 字体 名 称 ， 然 后 用 RegWiite 方法 设置 为 “华文 仿宋 ”。 


Sub Test4() 
Dim WS As New IWshRuntimeLibrary.WshShell 
Dim fontname As String 


With WS 
fontname = .RegRead ("HKEY CURRENT USER\Software\Microsoft\Notepad\lfFaceName") 
MsgBox " 记事 本 程序 现在 的 字体 是 : " & fontname re 
-RegWrite Name:="HKEY CURRENT USER\ 文件 (月 ” 蝙 辑 ( ”格式 (O) 查看 (V) 帮助 (H) 
Software\Microsoft\Notepad\1fFaceName"， Value:=" 华文 春雨 惊 春 清 谷 天 
仿宋 "，Type:="REG_ SZ" 严 漠 革 攻 量 相 六 
ee 冬 雪 雪 冬 小 大 赛 
运行 上 述 代码 后 ， 再 次 打开 记事 本 程序 ， 可 以 看 到 字 。 册 232 修改 注册 来 、 从 而 修改 
体 风 格 已 改变 ， 如 图 2-32 所 示 。 记事 本 程序 的 字体 设置 
2.3.4 ”创建 新 项 


在 编程 过 程 中 ， 除 了 修改 现 有 项 目 外 ， 很 多 情况 下 需要 创建 新 的 子 项 。 

例 如 HKEY _ CURRENT _USER\Software\Microsoft\Office\Excel\Addins\customUI Excel 
这 个 注册 表 项 类 似 于 资源 管理 器 中 的 文件 夹 ， 该 注册 表 项 的 本 身 属 性 是 一 个 字符 串 :“ By 
Ryueifu”， 此 外 ， 该 注册 表 项 还 包括 4 个 属性 子 项 。 

口 Description 字符 串 子 项 : 属性 值 是 CustomUI Excel。 

口 FriendlyName 字符 串 子 项 : 属性 值 是 CustomUI Excel。 

口 LoadBehavior 整数 子 项 : 属性 值 是 2。 

口 Manifest 字符 串 子 项 : 属性 值 是 一 个 路 径 文 本 。 

右 击 注册 表 项 ， 可 以 在 弹出 菜单 中 为 已 有 子 项 的 注册 表 项 添加 新 的 子 项 ， 如 图 2-33 
所 示 。 


REGSZ 时 Re 
B cickToRn Deserption REG sz usemULEeea 
Co FriendlyName REGSZ customUL Excel 
ee LoadBehavor REG_DWORD ow00000007 四 


REGSZ ley//D:TEXTEOOK/Vs/custa| 


» OLE/COM Object terface Viewer 
» BOLE/COM Object Viewer 
OneDrive 

PeerNet 


图 2-33 为 注册 表 创建 新 项 
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在 注册 表 中 右 击 customUI Excel 注册 表 项 ， 在 弹出 菜单 中 可 以 新 建 属性 子 项 ， 也 可 以 
新 建 类 似 于 文件 夹 一 样 的 目录 子 项 。 

使 用 VBA 同样 可 以 创建 新 项 。 下 面 的 过 程 包含 4 个 修改 注册 表 命 令 ， 其 中 前 两 个 修改 
现 有 子 项 的 数值 ， 第 3 个 命令 增加 一 个 名 为 Version 的 属性 子 项 ， 第 4 个 命令 增加 一 个 名 为 
User 的 目录 子 项 。 


Sub Test5() 
Const parent As String = "HKEY _ CURRENT USER\Software\Microsoft\Office\Excel\ 
Addins\" 
Dim WS As New IWshRuntimeLibrary.WshShell 
With WS 
.RegWrite Name:=parent & "customUI Excel\"，Value:="Ryukou" ' 修改 本 身 属性 
.RegWrite Name:=parent & "customUI Excel\Description",，Value:=" 对 插件 的 


描述 信息 "，Type:="REG SZ" "修改 已 有 属性 值 
-RegWrite Name:=parent & "customUI Excel\Version", Value:="2", Type:= 
"REG_DWORD" ' 创建 属性 子 项 Version=2 


.RegWrite Name:=parent & "customUI Excel\User\"，Value:=" 注册 表 小 白 " 


' 创建 子 文件 夹 ， 并 赋予 本 身 属性 值 
End With 
End Sub 


运行 上 述 过 程 ，customUI Excel 的 注册 表 项 发 生变 化 ， 如 图 2-34 所 示 。 


Access 


MoedBehovior REG.DWORD 。。 0x00000002 [2) 
Morifest REGSZ ley//DY/TEXTBOON/VS/custd| 
动 verion REG_DWORD 2 


上 customULExcel 
BD EeeLveE APlViewer Connect 
3 | 
上 KOMsAddinkExcelMacroncdin 肿 
点 PowerPivotExcelClientAddin.Netvef 
ee 
内 对 茵 楼 板 LConnect 

| 

人 


09- OLE/COM Objerr Interface Viewer 


| = 


EMHKEY. CURRENT_USER\Sofrware\Microsofn\ OfFce\ExceNAddins\e 


图 2-34 使 用 代码 自动 修改 注册 表 

需要 特别 注意 的 是 ， 注 册 表 路 径 末 尾 是 否 添加 反 斜 枉 ， 对 操作 后 的 影响 非常 大 ， 例 
如 RegWrite Name:=parent & "customUI Excel\", Value:="Ryukou" 这 一 句 的 含义 是 修改 
customUI Excel 的 默认 属性 为 Ryukou。 

如 果 写 成 RegWrite Name:=parent & "customUI Excel", Value:="Ryukou" 则 表示 在 Addins 
这 个 注册 表 项 下 面 创建 一 个 名 为 customUI Excel 的 属性 子 项 ! 

因此 , 在 VBA 中 使 用 RegRead、RegWrite 和 了 RegDelete 方 法 对 注册 表 项 进行 操作 时 ， 
一 定 要 思考 加 与 不 加 反 斜 杠 的 区 别 。 
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以 上 内 容 的 源 代码 文件 为 “实例 文档 08.xlsm” 。 


2.4 创建 快捷 方式 


Windows 允许 用 户 在 文件 夹 中 或 者 桌面 (桌面 是 系统 盘 下 的 一 个 特殊 文件 夹 ) 为 文件 或 
网 址 创建 快捷 方式 。 所 谓 的 快捷 方式 ， 其 实 是 一 个 扩展 名 为 .Ink 的 图 标 文件 。 

在 桌面 上 查看 搜狗 高 速 浏览 器 的 快捷 方式 的 属性 ， 可 以 看 到 这 个 快捷 方式 指向 的 文件 
是 SogouExplorerexe， 也 就 是 说 ， 双 击 快捷 方式 就 相当 于 双击 了 搜狗 高 速 浏览 器 的 执行 文 
件 ， 如 图 2-35 所 示 。 

然后 切换 到 “详细 信息 ”选项 卡 ， 可 以 看 到 该 快捷 方式 的 完整 路 径 ， 如 图 2-36 所 示 。 


请 请 息 文人 村 性 
某 规 -| 快捷 方式 。 上 兼 罕 性 = | 安全 


的 搜狗 高 束 浏 览 器 


目标 类 型 用 程序 

风 EE 类 快捷 方式 | 
目标 位 置 。 Sogoukxplorer 文件 夹 路 径 C:\ 用 户 \ryuei fo\ 虎 面 | 
目标 上 A\Local\Sogohxplorer\Sogoulxplorer. exe 大 小 1.95 1 


创建 日 期 ”2017/3/24 19:33 
2017/8/20 18:46 
起 始 位 置 5) ers\ryueifu\AppData\Local\SogouExplorer a 5 


| 川 | | 所 有 者 ryueifu_VBA\ryueifu 
快捷 键 00: 元 ei 
这 方式) 清 具 站 Re 

备注 O) 

[打开 文件 位 置 ) ] 攻 允 图 标 C). .| [高 级 0).…- 


图 2-35 搜狗 高 速 浏览 器 的 桌面 快捷 方式 图 2-36 快捷 方式 的 详细 信息 
看 到 所 在 路 径 是 桌面 ,文件 名 是 “搜狗 高 速 浏览 器 .Ink”。 


2.4.1 创建 文件 的 快捷 方式 


创建 快捷 方式 也 可 以 通过 编程 的 方式 实现 。 具 体 步 又 如 下 。 

首先 ， 使 用 WshShell 的 CreateShortCut 方 法 创建 一 个 快捷 方式 ,会 产生 一 个 
WshShortcut 对 象 ， 然 后 ， 为 该 对 象 设置 有 关 属 性 。 

口 TargetPath: 目标 路 径 ， 也 就 是 快捷 方式 指向 的 文件 路 径 。 

口 IconLocation: 自 定 义 图 标的 位 置 ， 也 就 是 .ico 格式 的 图 标 文件 位 置 。 

口 HotKey: 快捷 键 。 

最 后 ， 保 存 快捷 键 。 

当然 ， 在 创建 快捷 方式 之 前 应 该 先 判断 桌面 是 否 已 经 有 了 同名 的 快捷 方式 ， 如 果 已 存 
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在 ,会 创建 失败 。 
下 面 的 代码 首先 判断 桌面 上 是 否 存 在 Windows 计算 器 的 快捷 方式 ， 如 果 已 有 快捷 方式 ， 
则 弹出 警告 对 话 框 ， 不 予 创建 。 否 则 ， 自 动 在 桌面 创建 一 个 名 为 calc.lnk 的 快捷 方式 。 


Sub CreateShortCut () 
Dim WS As New IWshRuntimeLibrary.WshShell 
Dim FSO As New IWshRuntimeLibrary.FileSystemObject 
Dim Desk As String 
Dim mySht As IWshRuntimeLibrary.WshShortcut 
Desk = WS.SpecialFolders ("Desktop") 
If FSO.FileExists(Desk & "\calc.lnk") Then 
MsgBox " 已 存在 桌面 快捷 方式 ,拒绝 创 建 ! "，vbCritical 


Else 
Set mySht = WS.CreateShortCut (Desk & "\calc.1lnk") 
With mySht 
.TargetPath = "C:\Windows\System32\calc.exe" 
.IconLocation = "C:\temp\WN.ICO" 
.Hotkey = "Ctrl+Alt+F7" 
.Save 
End With 
End If 
End Sub 


代码 分 析 : 变量 Desk 用 来 获取 桌面 所 在 的 文件 夹 路 径 ， 对 象 变 量 mySht 就 是 快捷 方式 
本 身 。 读 者 可 以 根据 需要 自行 调整 TargetPath 、IconLocation 这 些 参数 。 

运行 上 述 代 码 后 ， 可 以 看 到 桌面 上 多 了 一 个 快捷 方式 。 图 2-37 所 示 为 calc 快捷 方式 的 
属性 。 


目标 类 型 
目标 位 置 :Systen32 
目标 0T): [C:\Windows\Syshen32\cale.exe | 


起 始 位 置 SG) 


快 后尘) Etly At 
入 R00 攻 REaaa 
备注 个): 六 | 
[打开 文件 位 置 ) ] 更改 图 标 (C),.. ] | 高 级 加 ).. 


[ 功用 内 


图 2-37 自动 创建 桌面 快捷 方式 
如 果 双 击 该 快捷 方式 ， 或 者 按 下 快捷 键 【 Ctrl+Alt+F7 ]， 会 自动 弹出 计算 器 。 
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2.4.2 ”创建 网 址 的 快捷 方式 


除了 可 以 创建 本 机 文件 的 快捷 方式 ， 还 可 以 创建 网 址 的 快捷 方式 ， 只 要 双击 该 快捷 方 
式 ， 就 自动 在 默认 的 浏览 器 中 打开 该 网 页 。 

网 址 快捷 方式 与 上 面 介绍 过 的 普通 快捷 方式 有 几 点 不 同 。 

口 对 象 类 型 不 同 ， 网 址 快捷 方式 的 对 象 类 型 是 WshURLShortcut。 

口 快捷 方式 扩展 名 不 同 ， 网 址 快捷 方式 的 扩展 名 是 -url， 不 是 .Ink。 

口 没 有 HotKey 属性 ， 不 支持 快捷 键 的 设 定 。 

下 面 的 过 程 自动 在 桌面 创建 一 个 网 址 快捷 方式 。 


Sub CreateURLShortCut () 
Dim WS As New IWshRuntimeLibrary.WshShel1 
Dim FSO Rs New IWshRuntimeLibrary.FileSystemObject 
Dim Desk As String 
Dim mySht As IWshRuntimeLibrary.WshURLShortcut 
Desk = WS.SpecialFolders ("Desktop") 
If FSO.FileExists(Desk & "\MaHouPao.url") Then 
FSO.DeleteFile Desk & "\MaHouPao.url" 
End If 
Set mySht = WS.CreateShortCut (Desk & "\MaHouPao.url") 
With mysht 
.TargetPath = "http://vba.mahoupao.net/forum.php" 
.Save 
End With 
End Sub 


代码 分 析 : 首先 判断 桌面 是 否 已 存在 该 网 址 快捷 方式 ， 如 果 存 在 ， 则 先 删除 。 
运行 上 述 代码 ， 会 看 到 桌面 多 了 一 个 快捷 方式 。 图 2-38 所 示 为 创建 的 MaHouPao 快捷 
方式 的 属性 。 


图 2-38 网址 快捷 方式 属性 
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2.5 ”操作 环境 变量 


环境 变量 (Environment Variables) 一 般 是 指 指定 操作 系统 运行 环境 的 一 些 参 数 ， 如 临时 
文件 夹 位 置 和 系统 文件 夹 位 置 等 。 

环境 变量 是 在 操作 系统 中 一 个 具有 特定 名 字 的 对 象 ， 它 包含 了 一 个 或 者 多 个 应 用 程序 
所 将 用 到 的 信息 。 例 如 Windows 和 DOS 操作 系统 中 的 path 环境 变量 ， 当 要 求 系统 运行 一 个 
程序 而 没有 告诉 它 程序 所 在 的 完整 路 径 时 ， 系 统 除 了 在 当前 目录 下 面 寻找 此 程序 外 ， 还 应 到 
path 中 指定 的 路 径 去 找 。 例 如 之 前 讲 过 的 Shell 函数 中 ， 可 执行 文件 的 路 径 可 以 不 写 前 面 的 
所 在 路 径 ， 只 写 文件 名 称 即 可 。 这 是 因为 这 些 文件 的 所 在 路 径 已 经 保存 在 环境 变量 中 。 

本 节 讲 述 如 何 用 WshShell 操作 环境 变量 。 

对 于 Windows 7 系统 ， 查 看 环境 变量 的 方法 是 ， 进 入 控制 面板 ， 单 击 “ 系 统 和 安 
全 ”一 “系统 ”一 “高 级 系统 设置 "， 然 后 在 “系统 属性 ”对 话 框 中 切换 到 “高 级 ”选项 卡 ， 
接着 单 击 “ 环 境 变 量 ” 按 钮 ， 如 图 2-39 所 示 。 


OO | 本 控制 面板 ， 系 闹 和 安全 ， 系统 E77 
= 
控制 面板 主页 查看 
网 设备 作 理 器 windod 
网 远 @ 设 重 ET EE 
国有 BR 护 | | 要 这 行 大 多 数 更 小 ， 您 必须 作为 管理 员 登 录 。 
琢 系 统 设置 性 能 
四 视觉 阔 果 ， 处 理 器 计划 ， 内 存 使 用 ， 以 及 虚拟 内 存 
用 户 配置 文件 
与 登录 有 关 的 旧 面 设置 
3 
启 :ho 站 障 收 团 
系 绞 启动、 系 绞 尖 败 和 调 汪 信 息 
号 清风 
强人 中 心 
Windows Update 计算 折 
性 信息 和 工具 i 
四 


图 2-39 设置 环境 变量 


然后 弹出 “环境 变量 ”对 话 框 ， 如 图 2-40 所 示 。 

对 话 框 分 为 上 下 两 部 分 ， 上 面部 分 是 用 户 变量 (User)， 
下 面 是 系统 变量 ( System)， 很 多 应 用 程序 都 把 重要 的 路 径 
保存 在 系统 变量 的 Path 变量 中 。 

以 系统 变量 为 例 ， 对 话 框 中 看 到 的 OS， 就 是 一 个 环境 
变量 的 变量 名 称 ， 而 后 面 的 Windows NT 是 一 个 字符 串 ， 
它 表示 变量 的 值 。 在 多 辑 上 ， 与 程序 语言 中 的 字典 ( 键 值 | 
对 ) 非常 相似 。 EE 

通过 环境 变量 对 话 框 可 以 进行 增加 、 删 除 、 修 改变 量 


图 2-40 “环境 变量 ”对 话 框 
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等 操作 。 
WshShell 对 象 下 面 有 一 个 Environment 成 员 ， 该 成 员 会 返回 一 个 环境 变量 集合 WshEnvironment 
对 象 ， 通 过 访问 该 对 象 ， 可 以 实现 环境 变量 的 查看 、 修 改 和 增删 。 


2.5.1 ”查看 和 遍历 环境 变量 
下 面 的 过 程 遍历 系统 环境 变量 (System) 的 所 有 变量 。 


Sub Testl() 
Dim WS As New IWshRuntimeLibrary.WshShell 
Dim SysVariables As IWshRuntimeLibrary.WshEnvironment 
Dim v 
Set SysVariables = WS.Environment ("System") 
With SysVariables 
Debug.Print " 变量 数量 为 "，.Length 
For Each V In SysVariables 
Debug.Print TV 
Next Vv 
End With 
End Sub 


代码 分 析 : 针对 遍历 到 的 每 一 个 变量 ，v 得 到 的 是 一 个 字符 串 ， 对 于 每 一 个 字符 串 ， 以 
= 为 分 界线 ， 等 号 左 侧 是 变量 名 ， 右 侧 是 变量 值 ， 如 图 2-41 所 示 。 


变量 数量 为 23 

CCHZPATH=C: \CTEX\CTeX\cect\fonts 

CCPKPATH=C: \CTEX\CTeX\fonts\pk\modeless\cct\dpi$d 

CLASSPATH=. ;%JAVA_HOME%\1ib\dt. jar;%JAVA_HOME%\lib\tools. jar; 
ComSpec=%SystemRoot%\system32\cmd. exe 

FP_NO_HOST_CHECK=NO 

JAVA_HOME=C:\Program Files\Java\jdkl1. 8.0_131 
JRE_HOME=C:\Program Files\JetBrains\PyCharm 2016. 3. 2\jre\jre\bin 
lib=C:\Program Files\SQLXML 4. 0\bin\ 

NUMBER_OF_PROCESSORS=4 

0S=Windows_NT 


图 2-41 遍历 系统 环境 变量 


如 果 要 单独 显示 变量 名 和 字符 串 ， 用 Split 函数 处 理 一 下 即 可 。 也 就 是 把 打印 语句 改 
为 如 下 形式 。 


Debug.Print Split(v, "=") (0), Split(v, "=") (1) 


如 果 要 查看 其 中 某 个 环境 变量 的 值 ， 可 以 用 Item 获取 。 
运行 下 面 的 过 程 ， 获 取 CCHZPATH 这 个 环境 变量 的 取 值 。 


Sub Test2() 

Dim WS As New IWshRuntimeLibrary.WshShell 

Dim SysVariables As IWshRuntimeLibrary.WshEnvironment 

Dim Vv 

Set SysVariables = WS.Environment ("System") 

MsgBox SysVariables.Item("CCHZPATH"), vbInformation, "CCHZPATH" 
End Sub 
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运行 上 述 过 程 ， 对 话 框 中 给 出 环境 变量 的 值 ， 如 图 2-42 


所 示 。 


如 果 要 遍历 用 户 环 境 变 量 ， 只 需要 把 上 述 过 程 中 的 WS. 
Environment("System") 替换 成 WS.Environment("User") 即 可 。 


2.5.2 ”新 建 和 修改 环境 变量 


CCHZPATH 


[i CACTEX\CTeX\cct\fonts 


[| w 宇 | 


图 2-42 获取 环境 变量 的 值 


无 论 是 新 建 一 个 环境 变量 ， 还 是 修改 已 有 变量 的 取 值 ， 语 法 都 是 一 样 的 。 


下 面 的 过 程 更 改 CCHZPATH 环境 变量 的 路 径 。 


Sub Test2() 
Dim WS As New IWshRuntimeLibrary.WshShell 
Dim SysVariables As IWshRuntimeLibrary. 
WshEnvironment 
Dim v 
Set SysVariables = WS.Environment ("System") 
SysVariables.Item("CCHZPATH") = "E:\ 
VBA; F: \DownLoad" 
End Sub 


运行 上 述 过 程 ， 然 后 在 环境 变量 对 话 框 中 核对 ， 
如 图 2-43 所 示 。 

再 例如 SysVariables.Item("Perfect") = "Ci:\temp" 可 
以 直接 创建 一 个 名 称 为 Perfect 的 新 环境 变量 ， 并 且 
赋值 。 


2.5.3 ”删除 环境 变量 


r 站 
EE 
ryueifu 的 用 户 变量 QU) 
朗 里 值 2 
FAT caauuiawniswieav 辐 
Ryueifu vhs mahoupao. net 
TPIP WUSERPEOFILEX\AppData\Local\Tenp 
TWP WISRRPRNFTI RE AnnNat a orcsl MTemn 2 
[EF TOE TE 
和 过量) | 
变量 值 A 
a 
CCPIEATK CMCTEX\CTeX\ fonts\pk\nodel ess\, | 
CLASSPATH RTAVA_MOMEX\Lib\ dt jar; JAVA_. | 
oaSa 
| 
ll 


l uk 


图 2-43 ”自动 修改 环境 变量 的 值 


使 用 环境 变量 对 象 的 Remove 方 法， 可 以 删除 指定 名 称 的 环境 变量 。 例 如 SysVariables. 
Remove "CCHZPATH" 把 名 为 "CCHZPATH" 的 环境 变量 删除 。 
如 果 要 删除 所 有 环境 变量 ， 循 环 调用 Remove 方法 即 可 。 下 面 的 代码 删除 User 下 的 所 


有 环境 变量 。 


Sub Test3() 


Dim WS As New IWshRuntimeLibrary.WshShell 


Dim SysVariables As IWshRuntimeLibrary.WshEnvironment 


Dim v 

Dim Col As New Collection 

Dim c 

Set SysVariables = WS.Environment ("User") 

For Each v In SysVariables 
Col.Add split(v, "=") (0) 

Next Vv 

For Each c In Col 
SysVariables.Remove Cstr(c) 

Next c 

End Sub 
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代码 分 析 : 如 果 在 循环 过 程 中 对 集合 中 的 元 素 进 [RAR Ea 
行 增删 ， 这 样 的 操作 比较 危险 。 因 此 ， 首 先 把 目前 所 ”|| [em 
有 的 环境 变量 的 名 称 保存 到 一 个 Collection 对 象 或 者 上 |” 
动态 数组 中 。 
然后 循环 Collection 中 的 每 一 个 字符 串 ， 再 移 除 人 
环境 变量 ， 如 图 2.44 所 示 。 Eee 
| 
2.6 自动 激活 指定 标题 文字 的 窗口 | i 
| CD Co 


WshShell 对 象 下 面 的 AppActivate 函数 可 以 激活 
屏幕 上 与 Office、VBA 不 相关 的 窗口 。 其 语法 是 : 图 2-44 批量 删除 所 有 环境 变量 


AppActivate (App, Wait) 


返回 一 个 布尔 值 ， 找 到 窗口 并 激活 ， 返 回 True， 否 则 返回 False。 

参数 App 表示 一 个 窗口 的 标题 文字 ， 是 字符 串 。 

参数 Wait 是 一 个 布尔 值 ， 设 置 为 True 时 ， 表 示 等 待 ， 也 就 是 当 激 活 完 成 后 ， 才 继续 执 
行 后 面 的 代码 。 

假设 桌面 上 启动 了 记事 本 ， 其 窗口 的 标题 文字 为 “无 标题 - 记事 本 ”， 然 后 在 工作 表 上 
插入 一 个 图 片 或 按钮 ， 指 定 宏 到 ActivateNotepad。 具 体 代码 如 下 。 


Sub ActivateNotepad () 
Dim WS As New WshShel1 
If WS.AppActivate (App:=" 无 标题 - 记事 本 "，Wait:=True) Then 
Debug .Print " 激活 成 功 " 
Else 
Debug .Print " 激活 失败 " 
End If 
End Sub 


当 单 击 工作 表 上 的 按钮 时 ， 记 事 本 窗口 自动 弹出 到 最 前 ， 取 得 焦点 ， 并 且 在 立即 窗口 打 
印 出 “激活 成 功 ”， 如 图 2-45 所 示 。 
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图 2-45 ”自动 激活 指定 标题 的 窗口 
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注意 标题 文字 必须 一 字 不 差 ， 如 果 记 事 本 已 经 关闭 ,或 者 App 参数 中 标题 文字 有 误 ， 
都 会 导致 AppActivate 函数 返回 False。 


2.7 ”自动 关闭 的 对 话 框 


VBA 中 的 MsgBox 对 话 框 主要 有 两 个 作用 ， 一 个 是 在 对 话 框 中 弹出 运行 结果 ， 用 于 告 
知 执行 程序 的 人 员 ; 另 一 个 作用 是 对 话 框 中 具有 “是 ”和 否 ” 取 消 ” 等 可 选 按钮 ， 让 用 户 抉择 。 

但 是 Msgbox 对 话 框 一 旦 弹出 来 ， 用 户 必 须 与 之 交互 ， 手 工 把 对 话 框 关 掉 方 可 执行 后 续 
的 程序 代码 。 

在 很 多 情况 下 ， 需 要 用 到 MsgBox 对 话 框 的 效果 ， 如 果 能 够 在 一 定时 间 范 围 内 自动 关 
闭 ， 就 更 为 理想 了 。 

WshShell 的 Popup 方法 可 以 弹出 一 个 对 话 框 ， 理 论 上 可 以 在 设 定 的 秒 数 之 后 自动 关闭 ， 
但 在 实际 运用 中 经 常 不 能 自动 关闭 。 

因此 ， 更 推荐 使 用 API 函数 来 设计 自动 关闭 的 对 话 框 。MsgBoxTimeonut 的 完整 声明 
如 下 。 


Declare Function MsgBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" (ByVal 
hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As 
VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) Rs Long 


参数 说 明 如 下 。 

口 hwnd: 对 话 框 依附 的 窗口 对 象 的 句柄 值 。 

口 lpText: 对 话 框 中 显示 的 内 容 。 

口 lpCaption: 对 话 框 的 标题 。 

口 wType: 对 话 框 显 示 的 按钮 、 图 标 风格 的 组 合 值 。 

口 wlange: 函数 扩展 。 

口 dwTimeout: 对 话 框 持续 的 最 长 毫秒 数 。 

MsgBoxTimeout 对 话 框 弹出 来 后 ， 如 果 用 户主 动 单 击 对 话 框 中 的 按钮 ， 则 对 话 框 在 设 
定时 间 之 前 就 提前 关闭 ， 此 时 该 函数 返回 的 整 型 值 与 用 户 所 选 按钮 相关 ， 若 置之不理 ， 则 对 
话 框 在 规定 时 间 过 后 自动 关闭 ， 自 动 关 闭 了 的 对 话 框 ， 其 返回 值 为 32000。 

下 面 的 程序 在 对 话 框 中 依次 弹出 一 些 判 断 题 ， 用 户 可 以 选择 “是 ”或 “和 否 ” 进 行 作答 ， 
如 果 没 来 得 及 单 击 按钮 ， 则 对 话 框 在 10 秒 后 自动 弹出 下 一 道 题 。 

程序 代码 如 下 。 


#If Win64 Then '64 位 
Private Declare PtrSafe Function MsgBoxTimeout Lib "user32" Alias "Message 
BoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption Rs String, 
ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long 
#Else 
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Private Declare Function MsgBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" 
(ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As 
VbMsgBoxStyle, ByVal wlange Rs Long, ByVal dwTimeout Rs Long) Rs Long 


#End If 


Sub 开始 答题 () 
Dim i As Integer 
Dim L As Long 
For i=2To06 
L = MsgBoxTimeout (hwnd:=0, lpText:=Range ("A" & i) .Value, lpCaption:=" 判断 
题 ",，wType:=vbYesNo + vbInformation, wlange:=1, dwTimeout:=10000) 
Select Case L 
Case 32000 
Range("B" & i) .Value = "未 做 " 
Case vbYes 
Range("B" & i) .Value = "是 " 
Case vbNo 
Range("B" & i) .Value = " 否 " 
End Select 
Next i 
End Sub 


代码 分 析 : hwnd:=0 表示 该 对 话 框 的 宿主 窗口 是 计算 机 的 屏幕 (屏幕 的 句柄 是 0)， 如 果 
设置 为 hwnd:=Application hwnd， 则 对 话 框 的 宿主 是 Excel 应 用 程序 ， 那 么 在 对 话 框 存续 期 
间 用 户 不 能 对 工作 表 和 单元 格 进行 任何 操作 ， 有 点 类 似 模 态 窗 体 。 

运行 上 述 程序 ， 弹 出 的 对 话 框 依次 显示 单元 格 中 的 每 道 题 ， 如 果 用 户 动作 慢 没 有 来 得 及 
选择 ， 则 在 B 列 标记 为 “未 做 ” ， 如 图 2-46 所 示 。 


A B C D E 
1 作答 
2_ | 用 所 的 后 有 二 位 数 ， 都 是 3 的 信 数 天 
3 是 5 的 信 冯 的 数字 ， 都 是 9 的 信 : 否 
4 高 中 一 班 出 勒 50 人 ， 缺勤 2 人 ， 出勤 率 是 96% 未 做 
5 | 同一 平面 的 两 条 直线 交点 个 数 最 多 是 1 
6 | 周 长 相 等 的 两 个 长 方形 ， 面 积 未 必 相 等 
7 
8 


图 2-46 ”指定 时 间 范 围 内 自动 关闭 的 对 话 框 
以 上 程序 的 源 代码 文件 为 “自动 关闭 的 对 话 框 .xlsm”。 


2.8 上 自动 发 送 按键 


日 常 办 公 过 程 中 ， 计 算 机 的 绝 大 多 数 操作 都 是 通过 操纵 鼠标 和 键盘 完成 的 。 对 于 Office 
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文档 的 处 理 ， 使 用 VBA 编程 可 以 很 好 地 完成 ， 但 是 如 果 要 处 理 屏幕 上 不 属于 Office 管辖 的 
窗口 ， 就 需要 自动 按键 、 自 动 单 击 鼠 标的 技术 。 

关于 自动 单 击 鼠标 ， 需 要 用 到 API 技术 ， 本 书 暂 不 作 介绍 。 
虽然 在 Excel VBA 中 Application 对 象 也 有 Sendkeys 方 法 ， 但 是 仅 限 于 Excel VBA， 
Office 的 其 他 组 件 ( PowerPoint、Word 等 ) 的 VBA 模型 中 并 未 提供 这 个 方法 。 因 此 ， 本 节 
讲述 更 加 通用 的 WshShell 的 Sendkeys 方法 以 实现 自动 按键 。 

熟练 掌握 自动 按键 ， 可 以 在 非 Office 窗口 中 实现 类 似 于 VBA 操作 的 效果 ， 更 大 程度 地 
减少 手工 操作 。 


2.8.1 按键 写法 


WshShell 的 Sendkeys 方法 的 功能 就 是 在 活动 窗口 中 ， 按 下 指定 的 键 (键盘 上 的 键 )。 这 
里 所 说 的 活动 窗口 就 是 屏幕 上 置 于 最 前 的 、 具 有 焦点 的 一 个 窗口 ， 而 并 非 其 代码 宿主 程序 

Sendkeys 语法 很 简单 ， 然 而 重点 和 难点 在 于 按键 字符 串 的 构造 。 因 此 首先 列 出 键 和 代 
码 的 对 应 关系 ， 如 表 2-4 所 示 


表 2-4 SendKeys 用 到 的 按键 写法 


按键 代码 
BACKSPACE {BACKSPACE}, {BS}. 或 {BKSP} 
BREAK {BREAK} 
CAPS LOCK {CAPSLOCK} 
DEL or DELETE {DELETE} 或 {DEL} 
DOWN ARROW {DOWN} 
END {END} 
ENTER {ENTER} 或 ~ 
ESC {ESC} 
HELP {HELP} 
HOME {HOME} 
INS or INSERT {INSERT} 或 {INS} 
LEFT ARROW {LEFT} 
NUM LOCK {NUMLOCK} 
PAGE DOWN {PGDN} 
PAGE UP {PGUP} 
PRINT SCREEN {PRISC} 
RIGHT ARROW {RIGHT} 
SCROLL LOCK {SCROLLLOCK} 
TAB {TAB} 
UP ARROW {UP} 
Fl {Fl1} 


F2 {F2} 
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续 表 
按键 代 码 
F3 {F3} 
F4 {F4} 
F5 {F5} 
F6 {F6} 
F7 {F7} 
Fg {F8} 
F9 {F9} 
F10 {F10} 
Fil {Fl11} 
F12 {F12} 
Fl13 {F13} 
F14 {F14} 
F15 {F15} 
F16 {F16} 
例如 ， 要 在 一 个 窗口 中 按 下 退 格 键 ， 书 写 代 码 的 方法 如 下 
WshShel1.SendKeys "{BACKSPACE}" 
下 面 的 实例 首先 启动 记事 本 ， 其 次 输入 英文 单词 ， 然 后 按 下 退 格 键 删 掉 最 后 一 个 字符 


Public Sub Delay(Interval As Single) 
Dim timer0 As Single 
timer0 = Timer 
Do While Timer - timer0 < Interval 
DoEvents 
Loop 
End Sub 
Sub Testl () 
Dim WS As New IWshRuntimeLibrary.WshShe1l1 
Shell "notepad", vbNormalFocus 
With WS 
Delay 1 
.SendKeys "Excel VBA" 
Delay 1 
.SendKeys "{BackSspace}" 
Delay 1 
.ApPACtivate "无 标题 - 记事 本 " 
End With 
End Sub 


代码 分 析 : Delay 过 程 用 于 延 时 ，Delay 1 表示 程序 暂停 1 秒 ， 这 个 技术 经 常用 于 自动 发 
送 按键 的 程序 中 。 

SendKeys "Excel VBA"， 相 当 于 依次 按 了 9 次 键盘 ， 每 次 按 的 都 是 字母 键 。 因 此 向 一 个 
接受 文字 的 区 域 输入 英文 句子， 就 可 以 采用 这 种 方式 。SendKeys "{BackSpace}" 千 万 不 能 写 
成 SendKeys "BackSpace"， 因 为 这 样 表示 连续 按 下 多 次 字母 键 。 
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除了 输入 英文 外 ， 还 可 以 输入 键盘 上 的 符号 ， 例 如 SendKeys "3*2=" 就 自动 输入 一 个 数 
学 题 。 

注意 ， 发 送 一 个 英文 字母 或 符号 可 以 用 花 括 号 括 起 来 ， 但 是 两 个 以 上 不 可 ， 例 如 
SendKeys "{M}" 是 允许 的 , 但 SendKeys {VBA}" 不 允许 。 


2.8.2 ”多 次 按 同 一 个 键 


如 果 要 多 次 按 下 同一 个 键 ， 键 码 必须 放 在 花 括号 内 ， 然 后 输入 空格 和 次 数 。 例 如 下 面 这 
些 示 例 。 

SendKeys "138{6 4} {8 4}" 表示 输入 13866668888。 

SendKeys "{Enter 3}" 表示 连续 按 下 3 次 回 车 键 。 

SendKeys "{+ 3} {一 3}" 表示 连续 按 3 次 加 号 ， 然 后 按 3 次 减 号 。 

利用 这 个 特点 ， 经 常 可 以 在 文字 中 移动 光标 ， 例 如 SendKeys "Microsoft{Left 4} {Right 
2}" 表示 在 记事 本 程序 中 输入 Microsoft 这 个 单词 ， 然 后 按 下 4 次 左 箭头 、2 次 右 箭 头 ， 从 而 
把 光标 移动 到 o 与 f 之 间 。 


2.8.3 组合 按键 


如 果 要 发 送 包含 Ctl、Alt、Shift 的 组 合 键 ， 分 别 用 ^、%、+ 表示 。 

SendKeys "^o" 或 者 SendKeys "^{0}" 表示 按 下 。【 Ctrl+O ])， 用 来 打开 文件 。 

SendKeys "+{F3}" 表示 按 下 快捷 键 【 Shift+F3 】。 

SendKeys "%f' 表示 按 下 快捷 键 【 Alt+F ]， 经 常用 于 显示 文件 菜单 。 

下 面 的 代码 向 记事 本 程序 输入 一 个 英文 句子 ， 然 后 调 出 记事 本 程序 的 替换 对 话 框 快 捷 键 
【 CtrlHH ]， 把 里 面 的 字母 o 全 部 替换 为 X。 


Sub Test2() 

Dim WS As New IWshRuntimeLibrary.WshShell 

Shell "notepad", vbNormalFocus 

With WS 
Delay 1 
SendKeys "Microsoft Office" 
Delay 1 
SendKeys “hh 
Delay 1 
.SendKeys 
Delay 1 
.SendKeys "{Tab}" 
Delay 1 
.SendKeys "XxX" 
Delay 1 
.SendKeys "%a™ 
Delay 1 
.SendKeys "“{ESC}™" 

End With 

End Sub 
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代码 分 析 : SendKeys "{fTab}" 表示 切换 控件 焦点 ， 也 就 是 从 查找 文本 框 切 换 到 替换 文本 
框 中 。 这 一 步 是 必 不 可 少 的 。 

在 记事 本 程序 的 蔡 换 对 话 框 中 ,“ 全 部 替换 ”按钮 中 有 个 带 下 面 线 的 字母 A， 意思 是 用 
【 AltrA ] 快捷 键 按 下 该 按钮 ， 因 此 采用 代码 SendKeys "%a"。 

最 后 一 句 代码 SendKeys "{ESC}"， 表 示 按 下 【 Escape 】 关 闭 蔡 换 对 话 框 。 

执行 上 述 过 程 ， 可 以 看 到 其 中 的 字母 被 替换 ， 如 图 2-47 所 示 。 


国 无 标量 -记事 本 
文件 月 ”编辑 (格式 (O) 查看 V) 帮助 (H) 
MicrXsxft Xffice 


昔 找 _ 
查找 内 容 m: 。 EA 
苦 换 为 @): xx 苦 换 EB) 

全 部 普 换 @) 

取消 


回 区 分 大 小 瑟 @) 


图 2-47 使 用 Sendkeys 自动 操作 记事 本 程序 


2.8.4 ”特殊 符号 的 输入 


前 面 讲 过 ， 双 引号 中 的 ^、%、+ 被 转 义 为 组 合 键 ， 如 果 需 要 输出 这 几 个 字符 本 身 ， 就 
需要 把 它们 放 在 花 括 号 内 。 例 如 ，SendKeys "{+} {%}" 表示 往 记 事 本 中 写 入 +%。 

此 外 ， 要 输出 花 括 号 本 身 ， 也 需要 把 它们 套 在 花 括 号 内 。 例 如 SendKeys "{}{G" 表示 
往 记事 本 中 写 人 }{。 


2.8.5 ”循环 中 使 用 按键 


如 果 按 键 的 内 容 相同 或 者 类 似 ， 可 以 把 Sendkeys 方法 放 在 循环 结构 中 ， 从 而 减少 
Sendkeys 的 书写 次 数 。 
下 面 的 代码 把 Excel 单元 格 区 域 中 的 内 容 顺 次 打印 到 记事 本 程序 中 。 


Sub Test3 () 
Dim WS As New IWshRuntimeLibrary.WshShel1 
Dim rg Rs Excel.Range 
Shell "notepad", vbNormalFocus 
With WS 
For Each rg In Sheet2.Range ("Al:C4") 
Delay 1 
.SendKeys rg.Value 
.SendKeys "{enter}" 
Next rg 
End With 
End Sub 
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可 以 看 出 代码 中 只 有 两 处 Sendkeys， 就 把 12 个 单元 格 的 内 容 发 送 到 记事 本 程序 中 ， 
如 图 2-48 所 示 。 


4 & B C D | 
1 |January February March 
2 |April NMay June 
July August September 
October November December 


w 


图 2-48 循环 使 用 Sendkeys 
下 面 是 一 个 技术 点 比较 综合 的 实例 ,希望 读者 仔细 分 析 其 细节 。 


Sub AutoRun () 
Dim WS As New IWshRuntimeLibrary.WshShell 
Dim Style As IWshRuntimeLibrary.WshWindowstyle 
Dim Result As Long 
With WS 
Delay 3 
Style = WshNormalFocus 
.Run Command:="notepad.exe", WindowStyle:=Style, WaitOnReturn:=False 


Delay 1 

.SendKeys "{* 5}By Liu YongFu{* 5}" ' 在 记事 本 程序 中 打字 
Delay 1 

.SendKeys "{Enter 2}" ' 按 2 次 换行 键 
Delay 1 

.SendKeys "{{}I will enlarge font-size!{}}" ' 在 记事 本 程序 中 打字 
Delay 1 

.SendKeys "{Enter 2}" ' 按 2 次 换行 键 
Delay 1 

.SendKeys "%o" ' 单 击 记事 本 程序 的 " 格式 ”菜单 

Delay 1 

.SendKeys "f" ' 单 击 " 字体" 
Delay 1 

.SendKeys "{TAB 2}" “连续 按 3 下 Tab 键 ， 焦 点 切换 到 字号 组 合 框 
Delay 1 

.SendKeys "{UP 2}" "连续 按 2 次 上 箭头 ， 增 大 字号 

Delay 1 

.SendKeys "{Enter}" " 确认 并 关闭 字体 对 话 框 
Delay 1 

.SendKeys "Now,Exit Notepad!" ' 继续 打字 

Delay 1 


.SendKeys "%{f}x" " 连续 按 下 快捷 键 【 Alt+F 外 X 键 
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Delay 1 
.SendKeys "n™ ' 询问 是 否 保存 ,选择 "No" 
End With 
End Sub 


2.8.6 ”关于 自动 按键 的 补充 说 明 


也 就 是 说 ， 不 仅 可 以 用 Sendkeys 方法 输入 文本 ， 还 可 以 自动 单 击 窗口 的 菜单 、 设 定 对 
话 框 中 的 控件 参数 等 。 

但 是 Sendkeys 存在 如 下 几 个 不 足 。 

口 不 能 发 送 中 文字 符 。 

口 不 能 发 送 一 部 分 特殊 按键 ， 例 如 Windows 键 (Ctrl 和 Alt 之 间 的 键 )。 

口 被 操作 的 窗口 不 能 被 遮挡， 不 能 失去 焦点 。 

对 于 中 文 或 其 他 字符 串 的 发 送 ， 可 以 借助 剪贴 板 的 功能 ， 先 把 中 文 发 送 到 系统 的 剪贴 板 
上 ， 然 后 发 送 按键 【 CtrltV 】 再 粘贴 中 文 即 可 。 

如 果 要 按 下 特殊 按键 ， 还 需要 借助 API 函数 ， 本 书 暂 不 讲解 API 函数 用 法 。 


2.9 ”使用 WshNetwork 对 象 


IWshRuntimeLibrary 下 面 的 WshNetwork 对 象 可 以 操作 局 域 网 多 台 计 算 机 的 对 象 ， 其 重 
要 属性 如 下 。 

口 ComputerName: 返回 计算 机 名 称 。 

口 UserName: 返回 用 户 名 。 

重要 方法 如 下 。 

口 MapNetworkDrive: 映射 网 络 驱 动 器 。 

口 RemoveNetworkDrive: 移 除 指定 的 网 络 驱 动 器 。 

与 打印 机 有 关 的 成 员 如 下 。 

口 EnumPrinterConnections: 枚 举 所 有 打印 机 。 

口 SetDefaultPrinter: 设置 默认 打印 机 。 


2.9.1 返回 计算 机 属性 


下 面 的 程序 返回 当前 计算 机 的 名 称 和 用 户 名 。 


Sub GetComputerProperty() 
Dim network As New IWshRuntimeLibrary.WshNetwork 
With network 
Debug.Print " 计算 机 名 称 : "， .ComputerName 
Debug.Print " 计算 机 名 称 : "，Environ ("ComputerName") 
Debug.Print "用 户 名 : "， .UserName 
Debug.Print "用 户 名 : "，Environ ("UserName") 
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End With 
End Sub 计算 机 名 称 : RYUEIFU_VBA 
计算 机 名 称 RYUEIFU_VBA 
运行 上 述 程 序 ， 立 即 窗口 的 打印 结果 如 图 2-49 ”| 用 户 名 : ryueifu 
用 户 名 : ryueifu 


所 示 。 


图 2-49 查看 计算 机 名 和 用 户 名 
2.9.2 ”映射 网 络 驱动 器 


映射 网 络 驱 动 器 功能 可 以 把 网 络 中 的 其 他 计算 机 或 服务 器 中 的 磁盘 、 路 径 映 射 为 当前 
计算 机 中 的 一 个 分 区 。WshNetWork 下 面 的 MapNetworkDrive 方法 可 以 实现 这 一 功能 ， 其 
参数 如 下 。 

口 LocalName: 本 地 驱动 器 名 称 。 

口 RemoteName: 远程 服务 器 或 计算 机 中 的 路 径 ， 一 般 以 仆 加 上 计算 机 名 称 或 瑟 地 址 开头 。 

口 UpdateProfile: 是 否 保 存 映射 信息 到 本 地 计算 机 中 ， 默 认 值 为 False。 

口 UserName: 远程 服务 器 或 计算 机 的 用 户 名 。 

口 Password: 远程 服务 器 或 计算 机 的 密码 。 

假设 有 一 台 远程 计算 机 的 名 称 为 ryueifu VBA， 有 如 下 路 径 : 

D: \TEXTBOOK\Python 


运行 如 下 程序 就 可 以 把 该 路 径 映射 为 本 地 计算 机 的 乙 分 区 。 


Sub AllocateDrive() 
Dim network Rs New IWshRuntimeLibrary.WshNetwork 
network.MapNetworkDrive LocalName:="Z:", RemoteName:="\\ryueifu VBA\D$\ 
TEXTBOOK\Python", UpdateProfile:=False 
End Sub 


运行 上 述 程序 ， 本 地 计算 机 的 资源 管理 器 中 多 出 了 乙 分 区 ， 如 图 2-50 所 示 。 


Ea ER 
| 了 JECEE 3 于 
纸 织 ” 拷 统 属性 。。 罚款 或 更 改 竹 订 本 射 网 洁 拭 动 和 五 开 管 反面 三 
SE 二 大小。 可 月 实则。 文中 对 统 
守明 
三 全 (5 
于 计 和 所 GDA) 不 全 三 二 600GB 55.8GB NTFS 
FT se) me MGs 27L8 NT 
i | = em A 2GB 18568 NTFS 
dome | scram Pe 251cB 200G8 Nris 
Chestsbend | awn ns 24G8 505GB NTFE 
时 有 可 称 动 存储 的 设备 (1) 
是 Python NVyueifu YBA\DS\TEXTBOOR (73 om to sie 
Bidea “网 络 位 置 中 
上 beautfusoup4-450 呈 Python Gucifu VEANDS\TEXTBOON (2:) 网 具 驱 动 医 172GB 18.5GB NTFS 
Bbin * 其 他 
下 cheeamaa 


图 2-50 自动 映射 网 络 驱动 器 
与 之 相反 ， 使 用 RemoveNetworkDrive 可 以 移 除 指定 的 映射 分 区 。 


Sub RemoveDrive() 
Dim network As New IWshRuntimeLibrary.WshNetwork 
network.RemoveNetworkDrive Name:="Z:", Force:=True, UpdateProfile:=False 
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End Sub 


运行 上 述 程序 ，Z 分 区 自动 消失 。 
2.9.3 ”操作 打印 机 


WshNetwork 对 象 有 很 多 用 于 操作 打印 机 的 成 员 ， 例 如 EnumPrinterConnections 可 以 用 
于 枚 举 计算 机 中 所 有 的 打印 机 端口 和 名 称 。 
下 面 的 程序 枚 举 当 前 计算 机 上 所 有 的 打印 机 名 称 。 


Sub LoopPrinters () 
Dim network As New IWshRuntimeLibrary.WshNetwork 
Dim i As Integer 
Dim Printers As IWshRuntimeLibrary.WshCollection 
Set Printers = network.EnumPrinterConnections 
For i = 1 To Printers.Count Step 2 

Debug.Print Printers(i) ' 打印 机 名 称 

Next i 

End Sub 


代码 分 析 : 如 果 把 Debug Print Printers(i) 中 的 i 改 成 二 1 


口 名 称 。 发运 至 OneNote 2013 
运行 上 述 程 序 ， 立即 窗口 打印 出 所 有 打印 机 Microsoft XPS Document Writer 


Microsoft Office Document Image Writer 


名 称 ， 如 图 2-51 所 示 。 Adbe PDF 
SetDefaultPrinter 方法 则 可 以 设置 默认 打印 机 。 
Sub 设置 默认 打印 机 () 
Dim network As New IWshRuntimeLibrary.WshNetwork 
network.SetDefaultPrinter Name:="Adobe PDF" 


Debug.Print "默认 打印 机 : "，Application.ActivePrinter 
End Sub 


运行 以 上 程序 ， 更 改 默认 打印 机 ， 然 后 打印 出 默认 打印 机 的 名 称 ， 如 图 2-52 所 示 。 


则 打印 出 来 的 是 每 个 打印 机 的 端 


图 2-51 遍历 所 有 打印 机 


4 打印 机 和 传真 (5) 


Adobe PDF Fax Microsoft Microsoft XPS 。 发 送 至 OneNote | 
Office Document 2013 
Document Writer 


图 2-52 ”自动 设置 默认 打印 机 
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以 上 内 容 的 源 代码 文件 为 “实例 文档 09.xlsm”。 


2.10 本章 小 结 


本 章 讲解 了 Shell 函数 调用 其 他 可 执行 文件 的 方法 ,一 定 要 注意 Shell 函数 的 异步 问题 。 
在 注册 表 读 写 方面 ，VBA 内 置 函 数 GetSetting、SaveSetting 等 只 能 操作 注册 表 中 的 一 小 
部 分 ， 而 使 用 WshShell 对 象 的 RegRead、RegWrite、RegDelete 方法 可 以 读 写 注册 表 的 任何 


位 置 。 


第 3 章 


处 理 压 缩 文件 


在 日 常 办 公 中 ， 经 常用 到 文件 的 压缩 与 解压 缩 ， 这 些 操作 也 可 以 用 VBA 实 现 自动 
化 。 另 外 ，Office 2007 以 上 版 本 创建 的 文档 其 实 也 是 压缩 包 文件 ， 只 不 过 扩展 名 看 起 来 
是 Office 的 扩展 名 ， 因 此 ， 学 习 压 缩 和 解压 缩 的 知识 ， 有 助 于 理解 Office 开发 中 自 定义 
Office 界面 方面 的 知识 。 

文件 的 压缩 和 解压 缩 操作 有 以 下 两 个 主要 方式 。 

口 Shell 函数 调用 电脑 默认 的 压缩 工具 。 

口 使 用 Shell32 对 象 操作 .zip 压缩 文件 。 

第 一 种 方式 通用 性 比较 强 ， 几 乎 可 以 操作 任意 扩展 名 的 压缩 包 ， 缺 点 是 计算 机 必须 安装 
了 压缩 软件 。 

针对 第 二 种 方式 ， 不 需要 安装 压缩 软件 ， 用 代码 即 可 实现 压缩 和 解压 缩 ， 但 只 限于 扩展 
名 为 .zip 的 压缩 包 。 

本 章 包括 用 Shell 函数 调用 WinRAR 压缩 软件 以 及 使 用 Shell32 对 象 操 作 .zip 压缩 文件 
两 大 部 分 内 容 。 

本 章 用 到 的 外 部 引用 和 重要 对 象 如 下 。 

口 Microsoft Shell Controls And Automation 

> Shell32.Shell 


3.1 Shell 调用 WinRAR 


WinRAR 是 一 个 文件 压缩 管理 共享 软件 ， 由 Eugene Roshal (所 以 RAR 的 全 名 是 Roshal 
ARchive) 开发 。 首 个 公开 版 本 RAR 1.3 发 布 于 1993 年 。 

WinRAR 可 以 把 文件 ( 夹 ) 压缩 为 rar 或 .zip 格式 ， 如 图 3-1 所 示 。 

WinRAR 可 以 解压 的 格式 有 : .CAB、.ARJ、LZH、 .TAR、.GZ、.ACE、.UUE、.BZ2、 
JAR、JSO、.Z、.7Z、RAR5。 
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启动 WinRAR 软件 ， 单 击 WinRAR 软件 的 菜单 【选项 /设置 ] 弹出 “设置 ”对 话 框 ， 
切换 到 “集成 ”选项 卡 ， 可 以 设置 WinRAR 能 够 解压 的 文件 格式 ， 如 图 3-2 所 示 。 


i 
时 ns - by = ~。 纪 帮 本 
这 机 ”| 高 如 | 选 夺 [文件 [备份 | 时间 “| 注释 | 文件 列表 [查看 器 [安全 “| 集成 
压 编 文件 名 内 轩 面 
ee 园 同 添 加 WiaRAR 到 康 面 0) 
更 新 方式 0 园 zzc) mm 加 添加 WinRAR 到 开始 菜单 S) 
】 ”| 添加 并 苦 换文 件 S| tT-zip 团 创 尘 WinRAR 程序 组 人 ) 
选 顺 ur 
ZIP 上 外 所 
四 创 哇 自 解压 格式 于 统 文 件 0) 回 集 成 YinRAR 到 | 完 吕 ) 
方式 国人 江 内 压 第 文件 5) 加 层 要 的 上 下 文 菜单 1) 
回 添加 恢 夏 记录 ) 园 上 下 文 荣 单 里 的 图 标 0 
字 奥 大 小 中 日 惠 KE 文件 0 | Ee 
i 司 加 钙 定 FE 过 文 件 山 | 
pe 用 户 自 定义 压 编 文件 扩展 名 0) 
| 一 |] ET 
| 
广 柄 | | 亡 栈 ][ 驻 ][ 于 
图 3-1 “压缩 文件 名 和 参数 ”对 话 框 图 3-2 勾 选 关联 的 扩展 名 
je 一 . 7 
3.1.1 获取 WinRAR 可 执行 文件 路 径 


WinRAR 的 执行 文件 一 般 情况 下 位 于 C:\Program Files\WinRAR\WinRAR.exe， 如 果 个 别 
计算 机 把 这 个 软件 安装 到 其 他 位 置 ， 使 用 前 面 讲 过 的 WshShell 对 象 的 RegRead 方法 读 取 注 
册 表 可 以 获取 其 路 径 。 

下 面 的 GetSetupPath 函数 用 来 获取 指定 程序 名 的 安装 路 径 。 


Public Function GetSetupPath (APPName As String) 
Dim WSH As Object 
Set WSH = CreateObject ("WScript.SsShell") 
GetSetupPath = WSH.RegRead ("HKEY LOCAL MACHINE\Software\Microsoft\Windows\ 
CurrentVersion\App Paths\" & AppName & "\Path") 
Set WSH = Nothing 
End Function 


运行 下 面 的 过 程 ， 可 以 获取 WinRAR 软件 的 安装 路 径 以 及 PowerPoint 的 安装 路 径 。 


Sub Test 1() 
Debug.Print GetSetupPath ("WinRAR.exe") 
Debug.Print GetSetupPath ("Powerpnt .exe") 
End Sub 


上 述 程序 的 运行 结果 如 图 3-3 所 示 。 
TSD — = 本 = 


C:\Program Files\WinRAR 
C:\Program Files\Microsoft Office\Officel5\ 


图 3-3 从 注册 表 中 获取 应 用 程序 的 所 在 路 径 
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3.1.2 命令 和 开关 


获取 到 WinRAR.exe 的 所 在 路 径 ， 就 可 以 使 用 Shell 函数 调用 这 个 可 执行 文件 完成 压缩 
和 解压 缩 操作 。 
调用 格式 如 下 。 


Shell "WinRAR.exe 的 路 径 命令 开关 压缩 包 路 径 文件 路 径 ", vbNormalFocus (或 者 vbHide) 
下 面 通过 一 个 实例 来 介绍 一 下 各 参数 的 构造 方法 。 


Shell "C:\Program Files\WinRAR\WinRAR.exe A C:\temp\Regdll.rar C:\temp\65. 
png", vbNormalFocus 


以 上 语句 的 功能 是 ， 调 用 WinRAR.exe 把 65.png 图 片 文 件 压缩 到 Regdll.rar 这 个 压缩 包 
中 。 可 以 看 出 各 个 参数 之 间 用 空格 隔 开 ， 全 部 放 和 人 双 引 号 内 ， 形 成 了 一 个 长 的 字符 串 。 其 中 
的 A 就 是 一 个 命令 ， 表 示 压 缩 ， 上 面 这 个 实例 没有 用 到 开关 参数 。 

下 面 分 别 介绍 一 下 WinRAR 的 命令 参数 和 开关 参数 。 命 令 参数 的 功能 是 告知 WinRAR 
要 执行 什么 操作 ， 是 压缩 、 解 压缩 还 是 删除 。 开 关 参 数 是 对 命令 参数 的 补充 说 明 。 

WinRAR 命令 参数 


单 击 WinRAR 的 菜单 【帮助 /帮助 主题 ]， 可 以 打开 其 帮助 文件 ， 依 次 展开 节点 “命令 
行 模式 /命令 行 "， 可 以 看 到 所 有 命令 参数 的 说 明 ， 如 图 3-4 所 示 。 


国 WinRAR 帮助 文件 [= © lm) 
胃 中 急 _ 式 
隐 池 上 一 步 后 p 过 页 O) 
目录 C) | 索引 gp | 搜索) | 收藏) 字母 命令 列表 
ET ET ~ 
i 
站 Re a 添加 文件 到 压缩 文件 
Windows 资源 管理 器 中 
WD 命令 行 模式 c 添加 压缩 文件 注释 | 
i | 
Resamsm Wn 上 
国 “Aw- 添加 到 甘 编 广 件 中 | 
回 “c” - 添加 压缩 文件 注释 cv 转换 压缩 文件 
四“ 
D0” = 
国 “0 福生 人 放生 papgpgi 们 cw 写 入 一 个 压缩 文件 注释 到 文件 
目 避 - 人 人 从 纺 文 伯 而 除 文 
罗 “z” EE: d FE 
ee EE | 
pr | 
国人 e 从 压缩 文件 解压 压缩 ,忽略 路 径 | 
加 2 -人 人 
| | Bs a 
| J f 刷新 压缩 文件 中 的 文件 
四 “BH” - 重 命名 压缩 文 
加 “REIW] ” - 添加 数据 恢复 记 录 i 在 压缩 文件 中 查找 字符 串 
Bt 锁定 压缩 文 
“S[: ls 讨 格式 
国人 k 和 
回 “T”- 弄 坟 已 压 纺 8 汶 件 
加 “vw” - 更 新 压缩 文件 内 的 文件 m 移动 文件 和 文件 夹 到 压缩 文件 
@ 
日 者 ize 进出 码 r 修复 受 损 的 压缩 文件 有 
月 蜀 WinRAR 设 需 对话 枉 二 
a L re 重建 丢失 的 郑 : 
人 
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最 常用 的 4 个 命令 参数 及 其 功能 如 下 。 

口 A: 压缩 ， 添 加 到 压缩 文件 中 。 

口 D: 删除 ， 从 压缩 包 中 删除 文件 。 

口 E: 解压 缩 到 当前 目录 。 

口 X: 以 完全 路 径 解 压 。 

可 以 看 出 ， 从 压缩 包 中 解压 出 内 容 ， 有 王 和 两 个 命令 参数 。 其 实 ，E 命令 参数 等 
价 于 WinRAR 解压 参数 中 的 “不 要 提取 路 径 ”; 义 命令 参数 等 价 于 “提取 完整 路 径 "， 使 用 
WinRAR 软件 解压 一 个 压缩 包 时 ， 在 “ 视 级 ”选项 卡 里 可 以 看 到 解压 方式 选项 ， 如 图 3-5 所 示 。 


性 解压 路 径 和 选项 \» es 
[党 坑 | 高 只 | 
文件 时 间 属性 
国保 存 修改 时 间 0) 司 清 除 “存档” 属性 C) 
加 保存 凶 语 时间 C) 团 设置 文件 安全 信息 6) 
回 设置 最 近 访问 时 间 0 回 设 置 “压缩 ”属性 上) 
| 文公 量 除 压缩 文件 
提取 相对 路 径 &) 回 永 不 
| | “日 提取 寺 束 路径) X 询问 确认 00 
| 。 男 不 要 提取 路 径 m) 下 总 是 0 
| 提取 绝对 路 径 (0) 
| 其 它 
本 背景 提取 8) 
] 如 果 其 它 YinRAR 副本 活动 时 请 等 候 0) 
| ] 允 许 符号 返 接 里 出 现 绝对 路 径 0 
| | 日 允 许 潜在 的 不 兼容 名 称 fF) 
[确定 |[ 了 |[ 帮助 


图 3-5 命令 参数 相应 的 含义 


简 言 之 , E 就 是 忽略 压缩 包 中 的 路 径 ， 释 放 所 有 文件 到 目标 文件 夹 ， 而 义 则 按照 压缩 包 
原 有 的 路 径 结构 释放 到 目标 文件 夹 。 

WinRAR 开关 参数 

在 WinRAR 软件 的 帮助 文件 中 ,依次 展开 节点 “命令 行 模式 / 参数", 可 以 看 到 所 有 开 
关 参 数 的 说 明 ， 如 图 3-6 所 示 。 

下 面 是 比较 常用 的 开关 参数 。 

口 -ep: 忽略 路 径 。 

口 -ep1: 忽略 基准 路 径 ， 但 保持 现 有 文件 层次 结构 。 

口 -p 或 -hp: 压缩 时 加 密码 。 

口 -df: 压缩 后 删除 原文 件 。 

口 -dr: 压缩 后 删除 原文 件 到 回收 站 。 

大 致 了 解 命令 参数 和 开关 参数 后 ， 下 面 通过 具体 实例 加 深 学 习 。 
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本 wan TH 而 而 而 IE 一 >) 
过 让 
让 上 - 步 计 #。 搞 p 过 项 
EE I 参数 -EP1 - 从 名 称 中 排除 主 文件 夹 
[互生 ink 界面 = 
. a 次 和 管理 中 E 使 信行 路 径 。 
i 人 


日 四 杀 娄 级 元 
二 1 将 tmp 文件 夫 内 的 全 部 文件 和 文件 夹 添加 到 压 纺 文件 
Mest ,但 是 从 压缩 的 路 径 名 排除 mp 
WinRAR a -epl -r test tmp\* 
它 等 同 于 命令 


cd tmp 
WinRAR a -r - -Ntest 
二 大 :aa 


2 解压 文件 并 匹配 imagesy 掩 码 到 dest\ 目录 ， 但 从 已 创 
建文 件 的 路 径 里 删除 images\ 


WinRAR x -epl data images\* 
dest\ 


”- 属 
~ 扩展 路 径 为 包含 盘 符 的 完全 路 和 
-aft1 人 全 性 2 褒 导 立 件 捧 除 和 避 白 卫 


图 3-6 WinRAR 开关 参数 帮助 
3.1.3 ”压缩 


假设 文件 夹 “ 东 北三 省 ”中 的 内 容 如 图 3-7 所 示 。 


=- 国 | 吉林 
长 春 . txt 
局 -多 这 
-和 全] 大 连 
A 高 新 区 . txt 
加 txt 
导 - 国 黑龙江 
哈尔滨 . txt 
[省 从 .txt 


图 3-7 文件 夹 内 容 的 示意 图 


如 果 采 用 命令 A-ep 则 是 忽略 所 有 路 径 ， 也 就 是 忽略 文件 夹 及 其 子 文件 夹 ， 把 “东北 三 
省 ”下 面 管辖 的 所 有 文件 ( 含 递归 ) 压缩 进去 。 完 整 代码 如 下 。 


例 ofice VBA 开发 经 典 一 中 级 进 阶 郑 


Public Function GetSetupPath (AppName As String) 
Dim WS Rs New IWshRuntimeLibrary.WshShell “前 期 绑 定 
Set WS = CreateObject ("WScript.Shell") 
GetSetupPath = WS.RegRead ("HKEY LOCAL MACHINE\Software\Microsoft\Windows\ 
CurrentVersion\App Paths\" & AppName & "\Path") 
Set WS = Nothing 
End Function 
Private Function AddQuote (path As String) As String 
AddQuote = Chr(34) & path & Chr(34) & "" 
End Function 


Sub 文件 夹 及 其 内 容 添加 到 压缩 包 () 


Const WorkDir As String = "E:\" " 默认 目录 

Dim WinrarExe Rs String "WinRRAR 可 执行 文件 路 径 
Dim Command As String ' 命令 、 开 关 参 数 

Dim RarFile As String ' 压缩 包 路 径 

Dim Contents As String ' 文件 、 文 件 夹 的 路 径 
WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 
Command =" A-ep" 


RarFile = WorkDir & "packagel .rar" 
Contents = WorkDir & "东北 三 省 " "把 "东北 三 省 " 文件 夹 及 其 内 容 添加 到 压缩 包 
Shell AddQuote (WinrarExe) & Command & AddQuote (RarFile) & AddQuote (Contents), 
vbNormalFocus 
End Sub 


代码 分 析 : 函数 GetSetupPath 用 来 获取 WinRAR 软件 的 安装 目录 ， 函 数 AddQuote 用 来 
处 理 Shell 命令 路 径 中 的 空格 。 要 注意 Command 中 要 保留 必要 的 空格 。 

以 上 代码 段 中 ， 最 重要 的 一 句 就 是 最 后 Shell 函数 的 应 用 。 

运行 上 面 的 “文件 夹 及 其 内 容 添 加 到 压缩 包 ” 过 程 ， 会 在 E: 盘 下 生成 packagel.rar 压 
缩 包 ,手工 打开 后 ， 如 图 3-8 所 示 。 


| "er 
文 性 月 “命令 (O 工具 (S) 收藏 夫 (O) 运 项 (N) 帮助 (H) 
SS 、 一 
EA A 
语 In。 解 E 到 。 测试。 坦 看 。 出 除 可 近 。 向导 ”信息 | 扫 筷 遍 帮 ”注入 
国 。“ 改 packagel.rar - RAR 压 丹 文件 解 包 大 小 为 4 字 节 ~ 
辕 padkegelrar [各 不 E 莹 乓 大 小 类 型 修改 时 间 。 “ | 
上 | 
问 长 春 .bd 0 文本 文档 2017/12/24 11:32 
WE.bt 0 文本 文档 2017/12/24 11:32 
号 哈尔滨 ,bt 0 文本 文档 2017/12/24 11:32 
号 高 新 区 .xt 0 文本 文档 2017/12/24 11:33 
口音 份 .bt 4 文本 文档 2017/12/24 11:34 
[a 和 
EP 总 计 4 字 节 (5 个 文 促 


图 3-8 自动 执行 压缩 
可 以 看 到 ，A-ep 命令 把 文件 夹 中 所 有 的 “文件 ” 掏 出 来 ， 放 入 压缩 包 ， 而 不 管 这 些 文 
件 原先 在 何 处 。 
现在 只 需 把 上 述 代码 中 的 Command 换 成 "A-ep1"， 删 除 原先 的 压缩 包 ， 再 运行 一 次 程 
序 ,， 效果 如 图 3-9 所 示 。 
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于 padegelrar- WinRAR IE 一 > 


文件 (F) 命令 ( 〇 “工具 (S) 收藏 夫 (O) 远 项 (N) 帮助 (H) 


DIE 


a 
国 。 虱 packagelran\ 东 北三 四 \ 襄 林 - RAR 压 太 文件 解 包 大 小 为 4 字 - 
避 packagelrar | 站 ERE 大 小 关 至 修改 时 间 
hh 直 本 地 模 盘 

Bb ne | Bee 0 让 文 入 2017/12/24 11:32 

卡 二 林 

下 了 

和 大 连 


到 上 


EP 而 而 二 信用 _ 着 050 人 雹 
图 3-9 连 文件 夹 一 起 压缩 
可 以 看 出 ， 该 命令 保留 了 原先 文件 结构 。 因 此 ， 可 以 简单 地 理解 为 -ep 参数 只 压缩 文 


件 ，-epl 带 文件 夹 压缩 。 
在 实际 应 用 中 ， 根 据 需要 选择 开关 参数 即 可 。 


3.1.4 解压 缩 


解压 缩 是 将 压缩 包 中 的 内 容 释放 到 磁盘 下 的 操作 。 解 压缩 的 命令 有 了 和 X。 
下 面 的 过 程 把 压缩 包 packagel.rar 中 所 有 的 文件 解压 到 Destination 文件 夹 下 。 


Sub 解压 () 
Const WorkDir As String = "E:\" " 默认 目录 
Dim WinrarExe As String 'WinRAR 可 执行 文件 路 径 
Dim Command As String ' 命令 、 开 关 参 数 
Dim RarFile As String “压缩 包 路 径 
Dim Contents As String ' 文件、 文件 夹 的 路 径 


WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 
Command ="E™" 
RarFile = WorkDir & "packagel.rar™" 
Contents = WorkDir & "Destination" ' 释 放 到 Destination 路 径 下 
Shell Addouote (WinrarExe) & Command & AddQuote (RarFile) & AddQuote (Contents), 
vbNormalFocus 
End Sub 


运行 上 述 程 序 ， 把 压缩 包 中 的 文件 直接 释放 到 目标 文件 来， 如 图 3-10 所 示 。 

如 果 把 Command 改 为 Command = " X"， 再 次 运行 上 述 程序 ， 压 缩 包 中 的 文件 夹 和 文 
件 一 律 解压 到 目标 文件 夹 中 ， 如 图 3-11 所 示 。 

上 面 的 实例 把 压缩 包 中 所 有 内 容 解 压 到 目标 文件 夹 ， 使 用 以 下 代码 可 以 解压 压缩 包 中 指 
定 路 径 的 文件 ， 而 不 是 解压 全 部 文件 。 


Shell Rddouote (WinrarExe) & Command & Rddouote (RarFile) & ”东北 三 省 \ 辽宁 \*.*# " 
& AddQuote (Contents), vbNormalFocus 


例 ofice VBA 开发 经 典 一 中 级 进 阶 郑 


哈尔滨 .txt 
沈阳 .txt 
省 省 份 .txt 
长 春 . txt 
高 新 区 . txt 


图 3-10 自动 解压 
3.1.5 删除 


图 3-11 


WinRAR 使 用 命令 DD 删除 压缩 包 中 的 文件 或 路 径 。 
下 面 的 实例 把 packagel.rar 压缩 包 中 的 “吉林 ”文件 夹 删除 。 


Sub 删除 压缩 包 中 内 容 () 


连 文件 夹 一 起 解压 


Const WorkDir As String = "E:\" " 默认 目录 

Dim WinrarExe As String 'WinRAR 可 执行 文件 路 径 
Dim Command As String ' 命令 、 开 关 参 数 

Dim RarFile As String ' 压缩 包 路 径 


Dim Contents As String '， 压缩 包 中 待 删除 的 文件 、 文 件 夹 的 路 径 
WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 

Command ="D™" 

RarFile = WorkDir & "packagel .rar" 

Contents = " 东北 三 省 \ 吉林 " ' 把 "东北 三 省 \ 吉林 "压缩 包 中 的 路 径 删 除 

Shell AddQuote (WinrarExe) & Command & AddQuote (RarFile) & AddQuote (Contents), 


vbNormalFocus 
End Sub 


运行 上 述 程序 ， 删 除 压缩 包 中 的 “吉林 ”文件 夹 ， 如 图 3-12 所 示 。 


ET = 15 Ey) 
文件 从 ”命令 ( 口 、 工 具 ($) 收藏 天 (DO) 运 项 (N) 才 助 (H) 

EE 时 入 般 验 晤 村上 = 
Ex 珊 K 二 人 扫 岳 于 雪 。 汉 ) 
国 。 污 p>ctagelran 左 :t 三 富 \ 了 地 \ 大 连 - RAR EE 六 六 伯 , 角 外 大 小 为 4 六 节 ~ 

如 dzoclr> 全 各 EE 后 大 小 类 型 你 现时 间 
站 于 = 吉 | 再 二 :本 各 
BET swe 0 文 # 文 档 2017112124 1 
最 辽宁 
BS EESTEED] 


图 3-12 ”删除 压缩 包 中 指定 的 文件 夹 


3.1.6 ”使 用 通配符 


无 论 是 压缩 、 解 压缩 ， 还 是 删除 命令 ， 路 径 设 置 中 均 可 使 用 通配符 。* 表示 0 个 以 上 任 
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意 字符 ，? 表示 1 个 任意 字符 。 
下 面 的 程序 把 文件 夹 下 所 有 4 位 扩展 名 的 Word 文档 添加 到 Word.rar 压缩 包 中 。 


Sub 指定 类 型 的 文件 添加 到 压缩 包 () 


Const WorkDir Rs String = "C:\temp\" " 默认 目录 

Dim WinrarExe As String "WinRRR 可 执行 文件 路 径 
Dim Command Rs String ' 命令、 开关 参数 

Dim RarFile As String “ 压缩 包 路 径 

Dim Contents Rs String ' 文件、 文件 夹 的 路 径 


WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 
Command ="A-ep" 
RarFile WorkDir & "Word.rar™ 
Contents = WorkDir & "*.doc?" ' 把 四 位 扩展 名 的 Word 文档 (docx、docm) 添加 到 压缩 包 。 
Shell AddQuote (WinrarExe) & Command & AddQuote (RarFile) & AddQuote (Contents), 
vbNormalFocus 
End Sub 


运行 上 述 程 序 ， 将 文件 夹 中 所 有 的 Word 文档 添加 到 压缩 包 ， 如 图 3-13 所 示 。 


于 wordrar - WinRAR 0 区 
文件 月 ”命令 (C) 工具 (S) 收藏 大 (O) 运 项 (N) 帮助 (H) 


EL 


轿 ” 改 Word.rar - RAR 丰 列 文件 解 外 大 小 为 249.153 字 芋 


人 


中 对 werdrer 名称 大 小 ”压强 后 大 小 
| a 
| YY exam.docx 36634 33853 
| 5 国 车 符 与 湾 行 符 .docm 18657 15672 
畏 公 务 员 docx 12450 9715 
是 二 因 docm 27642 24888 
】 大 注 全 吉 中 心 docm 15305 12519 
| 修改 过 但 说 明 docx 138465 。 133530 


[a - - 总 计 249,153 字 节 (6 个 文件 ) 
图 3-13 批量 压缩 特定 类 型 的 文件 
下 面 的 代码 从 Word.rar 压缩 包 中 删除 启用 宏 的 Word 文档 (扩展 名 为 .docm)。 


Sub 删除 压缩 包 指定 类 型 的 文件 () 
Const WorkDir As String = "C:\temp\" "默认 目录 


Dim WinrarExe As String "WinRRR 可 执行 文件 路 径 
Dim Command As String ' 命令、 开关 参数 

Dim RarFile As String “压缩 包 路 径 

Dim Contents As String ' 文件、 文件 夹 的 路 径 


WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 
Command ="D" 
RarFile = WorkDir & "Word.rar" 
Contents = "*.docm" " 删除 扩展 名 为 docm 的 文件 
Shell AddQuote (WinrarExe) & Command & AddQuote (RarFile) & AddQuote (Contents), 
VvbNormalFocus 
End sub 


需要 注意 的 是 ， 由 于 是 从 压缩 包 里 面 删除 内 容 ， 所 以 代码 中 Content 的 赋值 不 需要 
WorkDir。 
去 行 上 述 程序 ， 删 除 压缩 包 中 扩展 名 为 docm 的 文件 ， 如 图 3-14 所 示 。 


例 ofice VBA 开发 经 典 一 中 级 进 阶 郑 


里 Wordra - WinRAR ee El >) 
ET 
EEA ES | 
话 h 解 F 到 。 更 式 。 二 看 制 和 。 可 扰 。 向 信息 | 扫 拓 所 
图 : 污 wordrar - RAR 压 纹 文 件 解 包 大 小 为 187.549 字 匡 -| 
可 Wordear 大 小 且 共 后 大 小 
36.634 33.853 肯 
12450 9715 
138465 。 133530 
ER ， 
Eb 总 计 187,549 字 节 (3 个 文件 ) | 


图 3-14 从 压缩 包 中 删除 指定 扩展 名 的 文件 


3.1.7 “处理 压缩 包 的 密码 


使 用 -pp 或 -hp 开关 参数 ， 可 以 压缩 为 加 密 的 文件 ， 也 可 以 从 添加 了 密码 的 压缩 包 中 解 
压 文 件 。-p 后 面 带 上 密码 ， 表 示 普 通 加 密 ， 手 工 双击 压缩 包 ， 会 看 到 压缩 包 中 的 文件 列表 ， 
每 个 文件 后 面 有 *。 

下 面 的 程序 把 文件 夹 中 所 有 扩展 名 为 .pdf 的 文件 添加 到 压缩 包 ， 并 且 设 置 解压 密码 为 
ryueifu, 


Sub 加 密 的 压缩 包 () 
Const WorkDir As String = "C:\temp\" " 默认 目录 
Dim WinrarExe As String "'WinRAR 可 执行 文件 路 径 
Dim Command Rs String ' 命令 、 开 关 参 数 
Dim RarFile Rs String ' 压缩 包 路 径 
Dim Contents Rs String ' 文件 、 文 件 夹 的 路 径 
WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 
Command = " A -ep -pryueifu " 


RarFile = WorkDir & "Lock.rar" 

Contents = WorkDir & "*.pdf™" 

Shell AddQuote (WinrarExe) & Command & AddQuote (RarFile) & AddQuote (Contents), 
vbNormalFocus 


End Sub 
运行 上 述 程 序 ， 然 后 打开 压缩 包 ， 会 看 到 处 于 加 密 状态 ， 如 图 3-15 所 示 。 
矣 Loderar - WinRAR y lo | 
文才 请 S(O， 工 具 S) 收 功 闪 (O) 壕 项 (N) 者 动 (H) 
ERLTEITL ET 
Eg 则 区 。 坦 看。 出险 。 查找 。 向 信息 | 扫 记 过 注 / 
图 “ 改 Lodkrar - RAR 压 统 文 件 , 解 包 大 小 为 6,135,904 字 节 加 
ET 大谷 大 小 故 六 后 大 小 类 型 
四 - 本 址 要 会 | 
加 地 学 信息 处 理 方法 pdf 4.893.371 。 4179.504 PDF 文件 
站 成 到 pdf* 131199 sl696 PDF 文 件 用 
2.pdf* 17754 13.456 PDF 文件 
国 。pdf* 35737 36736 pDF 文 件 
Eppdf* 35737 36736 PDF 文件 | 
上 | 全 球 全 融 中 心 指数 报告 11- 1 020.196 986.400 PDF 文件 
可 四 | 
ER 总 计 6135.994 字 忆 (6 个 文件 


图 3-15 自动 压缩 并 设置 解压 密码 


如 果 使 用 开关 参数 -hp ， 表 示 高 度 加密 ， 这 种 方式 
生成 的 压缩 包 ， 连 其 中 的 文件 列表 也 看 不 到 ， 如 图 3-16 
所 示 。 

对 于 设置 了 密码 的 压缩 包 ， 可 以 在 解压 命令 中 把 密 
码 传递 进去 。 

下 面 的 程序 把 刚刚 加 密生 成 的 Lock.rar 解压 到 test 
文件 夹 中 。 


Sub 解压 带 密码 的 压缩 包 () 
Const WorkDir As String = "C:\temp\" 


Dim WinrarExe Rs String 
Dim Command Rs String 
Dim RarFile As String 
Dim Contents As String 
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纺 入 密码 - 
为 加 的 压 绽 文 件 输入 密码 
Locle rar 
Ek) 
BE 6) 
用 于 所 有 压 六 文件 人) 
[ ET 天 ] 
| WN | 取 沿 | [| 部 助 


图 3-16 使 用 -hp 参数 高 度 加 密 


" 默认 目录 

"WinRRR 可 执行 文件 路 径 
' 命令 、 开 关 参 数 

' 压缩 包 路 径 

' 文件 、 文 件 夹 的 路 径 


WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 


Command = " xX -pryueifu " 
RarFile = WorkDir & "Lock.rar" 
Contents = WorkDir & "test" 


' 解压 到 test 文件 夹 


Shell AddQuote (WinrarExe) & Command & AddQuote (RarFile) & AddQuote (Contents), 


vbNormalFocus 
End Sub 


3.1.8 使 用 WinRAR 修改 Office 文档 


Office 2007 以 上 版 本 的 Office 文档 (.docx、.xlsx、.pptx 等 格式 ) 其 实 是 一 种 压缩 包 格 式 ， 
使 用 WinRAR 可 以 直接 打开 。 下 面 介绍 一 下 用 WinRAR 查看 和 修改 Excel 文件 的 方法 。 
实例 文件 “example01.xlsx” 有 3 个 工作 表 ， 表 名 从 左 到 右 依次 分 别 为 Jan、Feb、Mar， 


如 图 3-17 所 示 。 


国 晶 9- 0-; example01.xlsx - Excel 


wonaronp 


Fe 


图 3-17 Excel 工作 短文 件 


( 国 ”office VBA 开发 经 典 -一 中 级 进 阶 郑 


在 Excel 中 关闭 该 文件 ， 然 后 打开 WinRAR 软件 ， 按 下 快捷 键 【 Ctl+O ]， 浏 览 到 
example01.xlsx， 如 图 3-18 所 示 。 


y 
合 exampleOl.xlsx - WinRAR _ Ye el SS 
文件 月” 命令 BB 上 收藏 夫 (O) 迁 项 (N) 帮助 (H) 
EA © BQ 
信息 。 | 扫 柱 病 雪 
中 的 | example01.xlsx - ZIP 压 纺 文 件 , 解 包 大 小 为 17.035 字 节 ~ 
| 
川 国 =ampieolas| 名 称 大 小 压 六 后 大 小 类 型 
| 用 -rels | 国 - 本 和 | 
月 docprops rols Se 
| 
| by 3 Bx 文件 夫 
| Brels B docProps 文件 夫 
theme DtContent Types]xml 1.440 361 XML 文档 
几 worksheets 
| 
是 
| «| mn ED 上 
I 上 EE 总 计 3 文件 夫 和 1,440 字 节 (1 个 文件 ) 


图 3-18 使 用 WinRAR 打开 Excel 文 件 


在 WinRAR 中 看 到 Excel 文件 由 3 个 文件 夹 和 一 个 文件 构成 ， 继 续 展 开 名 为 x] 的 文件 
夹 ， 可 以 看 到 和 工作 表 信 息 有 关 的 内 容 ， 如 图 3-19 所 示 。 


小 exampleo1xlsx - WinRAR ”要 i ey 
文件 (月 ”命令 (C) 工具 (S) 收藏 天 (O) 逻 项 (N) 帮助 (H) 
SE 
罗 着 国 
话 如 测试 。 坦 看 。 出 除 。 二 拒 。 向 导 ”信息 | 扫 所 病毒 注释 。 自 解 | 
图 “的 example01xlsxvd - ZIP 压缩 文件 解 包 大 小 为 17.035 字 节 -| 
国 exampleO1xlsx 匀称 3} 大 小 压 后 大 小 类 型 | 
rels 有 本 二 到 
| -BD decprops Brels 文件 
| Ba Btheme 文件 实 
| rets Bworksheets 文件 实 | 
| ! ep DEC 1335 685 XML 文档 
| Won ec DsharedStringsxml 353 202 XML 文 档 
| Dstylesxml 1648 712 XML 文 档 
| 
ll 
| al ' 
| 电 m~o B 远 泽 1.335 主 节 (个 文 仙 ) 总 计 3 文件 夫 和 3.336 字 节 (3 个 文件 


图 3-19 查看 Excel 文 件 的 内 容 


手工 把 example01.xlsx 解压 到 磁盘 下 ， 生 成 了 一 些 扩展 名 为 .xml 的 文件 。 双 击 
Workbookxml， 会 在 正 浏览 器 中 打开 该 文件 ， 如 图 3-20 所 示 。 

其 中 <Sheets> 这 个 节点 中 存储 的 就 是 各 个 工作 表 的 名 称 和 顺序 。 

xml 文件 可 以 用 记事 本 程序 编辑 ， 因 此 接 下 来 用 记事 本 程序 打开 Workbook.xml 文件 ， 
把 Jan 这 个 工作 表 移 动 到 最 后 ， 并 且 把 Feb 这 个 表 的 名 称 修改 为 “二 月 ”。 修 改 好 后 ,在 正 
中 再 次 预览 ， 如 图 3-21 所 示 。 
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GO me eenper rd 
各 名 > 色 和 到 只 训 >。 着 夫 


妆 wax 门 5 下 
属 [车 Brek 
Le Btheme 
Ee ‖ .woncheee 
后 OneDrive 章 国 sheredsuingesm OO |s opceveaFsaeeuofice VBS mss » [ts [x ||P arp 


六 和 | 向 加 建 WP ”局 Rh 二 ” 利和 奖 站 村 介 算 首 美容 关 由 日 类 洁 男 半 站 ] 天 大 市 日 天山 KR11 
Vi | 价 - 目 - 口 画 Pj” 安 2(9- IBaO)” 加 - ” 


xml version—"1.0" encoding—"UTF-8" standalone—"yes" ?> 癌 

— <workbook xmins=*http:/1schemas.operxmilformats-org/spreadsheetml/2006/main” 

tp:/ /Schemas.openxmilformats.org/officeDocument/ 2006/relationships" 
\s-openxmlformats.org/markup-compatibility/ 2006" 


kod"6" IowactEdited-"6" rup3uid-"14420" /> 


<workbookPr codeName=ThisWorkbook defaultThemeVersion="153222° /> 
— <mec:AlternateContent amins:mc ="http://schemas.openxmlformats.org/markup-compatibility/2006'> 


me:Choice Requires—"x15"> 
<G5aciabspath url="E:\OfficeVBA 开 发 反 奥 \OfFice VBA 升 发 经 典 -中 角 进 阶 养 源 代码 \ 处 理 压 第 文件 
mlns:z15ac="http://schemas-microsoft-comVoffice/spreadsheetml/2010111/ac' /> 


</me:Choice> 
</mc:AlternateContent> 
— <bookViews> 
workbookView xWindow=gn yWindow="0" windowWidth="15345" windowHeight="4665" 


activeTab="1" /> 
/bookViows> 
sheets> 
<sheet name="Jan" sheet 
<shoot name~"Feb" sheo 
<sheat name="Mar" sheet 


sheets> 
<calcpr calcid"153511" 7> 


图 3-20 查看 Excel 文件 内 部 的 部 署 清单 


— <sheets> 
<sheet name=" 二 月 " sheetId="2" r:id="r1d2" /> 
<sheet name="WMar sheetI rzd3" /> 
<sheet name="Jan" sheetId="1" r:id="rId1" /> 


</sheets> 


图 3-21 调整 工作 表 的 XML 代码 


然后 把 修改 了 的 Workbook.xml 文件 压 和 人 example01.xlsx 工作 簿 中， 在 Excel 中 再 次 
打开 ， 看 到 工作 表 的 名 称 和 次 序 发 生 了 变化 ， 如 图 3-22 所 示 。 


钱 日 操 ce = exampleO1.xlsx - Excel 
代数 生 市 网 。 视 四 开发 IT 具 加 束 硕 。 国 从 | 
"| 唱和 ffE 式 - | 可 扼 X- | 工 - 和 
脚 才 用 夫人 区 吉 油 ” 同 - 的 - 
茹 音 ilSf 二 ”| 首 检 ft， 包 - 


图 3-22 ”修改 后 Excel 文件 的 内 容 


可 以 看 到 Jan 工作 表 移 到 了 最 后 ，Feb 工作 表 被 重 命名 。 
Word、PowerPoint 文档 也 是 压缩 文件 ， 可 以 用 WinRAR 查看 和 打开 。 以 上 演示 的 是 手 


工 使 用 WinRAR 查看 、 修 改 Office 文档 ， 当 然 也 可 以 用 Shell 调用 WinRAR 进行 自动 解压 。 
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下 面 的 过 程 把 example01.xlsx 文件 中 的 Workbook.xml 部 分 解压 到 Destination 文件 
夹 中 。 


Sub 解压 office 文档 () 


Const WorkDir As String = "E:\" " 默认 目录 

Dim WinrarExe Rs String "WinRRR 可 执行 文件 路 径 

Dim Command Rs String ' 命令、 开关 参 数 

Dim RarFile Rs String ' 压缩 包 路 径 

Dim Contents As String ' 文件 、 文 件 夹 的 路 径 
WinrarExe = GetSetupPath ("WinRAR.exe") & "\WinRAR.exe" 

Command = "E™" 

RarFile = WorkDir & "example01.xlsx" 

Contents = WorkDir & "Destination" ' 释放 到 Destination 路 径 下 


Shell AddQuote (WinrarExe) & Command & AddQuote (RarFile) & " xl\workbook.xml " 
& AddQuote (Contents), vbNormalFocus 


End Sub 
如 果 是 带 有 自 定义 功能 区 的 文档 ， 用 压缩 包 打 开 后 ， 里 面 有 更 多 的 内 容 ， 这 些 在 稍 后 的 
章节 讲解 。 


以 上 内 容 的 源 代码 文件 为 “实例 文档 10.xlsm”。 


3.2 ”使 用 Shell32 对 象 


Shell32 对 象 中 的 Folder 对 象 与 FSO 文件 系统 对 象 中 的 Folder 用 法 非常 相似 ， 都 能 代 
表 计 算 机 中 的 一 个 文件 夹 。 但 是 ，Shell32.Folder 还 可 以 表示 一 个 扩展 名 为 .zip 的 压缩 文件 ， 
而 FSO 不 能 操作 到 压缩 文件 的 内 部 。 

因此 ， 本 节 介 绍 一 下 用 Shell32 对 象 处 理 计算 机 中 的 文件 夹 和 文件 以 及 .zip 压缩 包 中 的 内 容 。 


3.2.1 引入 Shell32 对 象 


前 期 绑 定 方式 : 在 VBA 工程 中 添加 外 部 引用 “ Microsoft Shell Controls And Automation”， 
如 图 3-23 所 示 。 


引用 -VBAProject 
可 使 用 的 引用 (A) 
取消 
浏览 B)... 
才 助 00 


rary 
DActivellovie control type library ba 
DAetiveX DLL to perforn Migration o: 
DAdHocReportineExcelClientLib 
口 inal 


四 一 ， 


Mcrosoft Shell Controls And Antomation 
定位 :CC:MWindows\systen32\shell32. dl 
语言 : 标准 


图 3-23 添加 外 部 引用 


第 3 章 处 理 压 续 文件 @) 


代码 中 使 用 Dim ShellApp As New Shell32.Shell 声明 了 一 个 新 的 Shell32 的 应 用 程序 对 象 。 
后 期 创建 对 象 的 方法 如 下 。 


Set ShellApp = CreateObject ("Shell .Application") 


3.2.2 ”使 用 namespace 返回 文件 夹 


FSO 对 象 中 ,使 用 GetFolder 返回 一 个 Folder 对 象 ， 而 Shell32 对 象 中 ， 使 用 namespace 
返回 一 个 Folder 对 象 。 


Sub Testl () 
Dim ShellApp As New Shell32.Shell, fd As Shell32.Folder 
With ShellApp 
Set fd = .Namespace("C:\temp") 
Debug.Print fd.Items.Item.Path “' 返回 文件 夹 的 路 径 
Debug.Print fd.Items.Count " 返回 该 文件 夹 中 包含 的 内 容 个 数 ( 子 文件 夹 + 文 件 ) 
End With 
End Sub 


以 上 过 程 中 ,， 乌 是 一 个 文件 夹 对 象 变量 ， 本 例 用 它 来 指 代 Ci\temp 这 个 文件 夹 。 
运行 上 述 程 序 ， 在 立即 窗口 打印 文件 夹 的 路 径 、 子 文件 夹 和 文件 的 总 数 ， 运 行 结果 如 


图 3-24 所 示 。 
上 面 的 实例 中 ,文件 夹 的 规定 是 在 namespace 的 参数 Ce 
中 直接 指定 的 ， 如 果 要 让 用 户 选择 一 个 文件 夹 ， 则 可 以 使 用 


BrowseForFolder 也 数 。 图 3-24 ”运行 结果 


3.2.3 ”文件 夹 选择 对 话 框 


BrowseForFolder 函数 的 语法 如 下 。 
BrowseForFolder (Hwnd, Title, Options, RootFoler) 


返回 一 个 Folder 对 象 。 各 参数 说 明 如 下 。 

口 Hwnd: 对 话 框 的 所 属 句柄 ， 长 整 型 。 设 置 为 0 表示 在 桌面 弹出 对 话 框 。 

口 Title: 对 话 框 显示 的 提示 语 。 

口 Options: 对 话 框 样式 设 定 参数 ， 十 六 进 制 数 。 

口 RootFolder: 文件 夹 选择 对 话 框 的 起 始 路 径 ， 也 可 以 是 特殊 的 文件 夹 常量 。 

下 面 的 代码 在 Excel 上 面 弹 出 一 个 文件 夹 选 择 对 话 框 ， 起 始 目录 设置 为 安 所 在 工作 短 的 
路 径 。 


Sub Test2 () 
Dim ShellApp As New Shell32.Shell, fd As Shell32.Folder 
With ShellApp 
Set fd = .BrowseForFolder (Hwnd:=Application.Hwnd，Title:=" 你 必须 选择 一 个 
文件 夹 : "， Options :=&H0，RootFolder:=ThisWorkbook.Path) 
IE fd Is Nothing = False Then 
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Debug .Print fd.Items.Item.Path 机 攻 滞 )] 
End If 
End With 
End Sub 测 处 理 压缩 文件 
代码 分 析 : BrowseForFolder 函数 弹出 浏览 文件 夹 对 ey | 
话 框 ， 用 户 选择 文件 夹 并 单 击 “确定 ”按钮 ， 伺 会 返回 国 | 
一 个 Folder 对 象 ， 如 果 单 击 “ 取 消 ”按钮 ， 那 么 伺 就 是 i 
Nothing。 | 二 
= 、 
运行 上 述 程 序 ， 自 动弹 出 一 个 选择 文件 夹 的 对 话 框 ， | 
如 图 3-25 所 示 。 图 3-25 ”浏览 文件 夹 对 话 框 


3.2.4 ”遍历 文件 夹 中 的 内 容 


Shell32 中 的 FolderItem 对 象 是 指 包含 在 文件 夹 中 的 文件 或 子 文件 夹 。 
假设 D:\Download 下 的 文件 内 容 如 图 3-26 所 示 。 


[ 本 本 一 一 | 
GO Hm, RED，powmlood » Be EZ 万 
担 织 ” 。 包 会 到 库 中 >。 共享 ” 新建 文件 突 -© 
放生 和 昼 改 日 其 wn 大 小 
及 下 二 a B Debug 2016/2/24 18:00 文件 实 
于 点 5 此 Lenovobjbxkqd 2012/10/21 15:53 ”文件 充 
各 是 加 downzip 2012/10/21 15:52 ”WinRAR ZIP arch.. 27.059 KB 
可 OneDrive 邮 ExcelObject VSTO VBA Setup.. 2016/2/24 17:38 。 Windows Install-. 504 KB 
口 VMwarel07z 2014/9/11 22:17 了 2 文件 471.380 KB 
洒 库 忆 xp-JPIMEPatchexe 2006/2/13 12:53 应 用 程序 42.198 KB 
虱 作 提 昌文 给 和 法 rar 2012/10121 16:57 WinRAR archive C42,198 KB 
Ca 
图 片 
国 z 机 -~ 有 
7 个 允 象 


图 3-26 文件 夹 中 的 内 容 


文件 夹 中 有 2 个 子 文件 、5 个 文件 。 
下 面 的 代码 遍历 Download 文件 夹 下 所 有 项 目的 路 径 、 类 型 。 


Sub Test3() 
Dim ShellApp Rs New Shell32.Shell, fd Rs Shell32.Folder, item Rs Shell32. 
FolderItem 
With ShellApp 
Set fd = .Namespace("D:\Download") 
IE fd Is Nothing = False Then 
Debug.Print fd.Items.Count ' 返回 该 文件 夹 中 包含 的 内 容 个 数 ( 子 文件 夹 + 文件 ) 
For Each item In fd.Items 
Debug.Print item.Path, item.Type 
Next item 
End If 
End With 
End sub 
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运行 上 述 程 序 ， 立 即 窗口 打印 出 文件 夹 中 的 所 有 内 容 ， 如 图 3-27 所 示 。 


D:\Download\Debug 


文件 夹 
D: \Download\down. zip WinRAR ZIP archive 


D: \Download\ExcelObject_VSTO_VBA SSetmp msi 


D: \Download\Lenovobjbxkad 

D: \Download\VMware10. 7z 72 文件 
D: \Download\XP-JPIMEPatch. exe 

D: \Download\ 收 复 日 文 输入 法 . rar 


应 用 程序 
WinRAR archive 


Windows Installer 程序 包 


图 3-27 遍历 文件 夹 中 的 内 容 


可 以 看 出 ， 子 文件 夹 的 Type 是 “文件 夹 ”。 
如 果 要 遍历 所 有 子 文件 夹 中 的 所 有 内 容 ， 需 要 用 下 面 的 递归 函数 。 


Sub Recursion(ByVal Parent As Shell32.Folder) 


Debug.Print Parent.Title 
For Each f In Parent.Items 
If f.Type = "文件 夹 " Then 
Recursion f.GetFolder 
Else 
Debug.Print f.Path 
End If 
Next 工 
End Sub 


Sub 遍历 所 有 内 容 () 


Dim ShellApp Rs New Shell32.Shell, fd As Shell32.Folder, 


FolderItem 
With ShellApp 


Set fd = .Namespace("D:\Download") 


Recursion fd 
End With 
End Sub 


item As Shell32. 


运行 上 面 的 “遍历 所 有 内 容 ” 这 个 过 程 ， 立 即 窗口 打印 出 Download 文件 夹 下 的 所 有 内 


容 (包含 递归 文件 夹 )， 如 图 3-28 所 示 。 


Download 
Debug 


D: \Download\down. zip 


Lenovobjbxkad 


D:\Download\VMwarel10. 7z 
D: \Download\XP-JPIMEPatch. exe 
D:\Download\ 修 复 日 文 输入 法 . rar 


D:\Download\Debug\ExcelWorkbook]1. 
D:\Download\Debug\ExcelWorkbookl1. 
D:\Download\Debug\ExcelWorkbook1. 
D: \Download\Debug\ExcelWorkbookl1. 
D:\Download\Debug\ExcelWorkbookl 

D:\Download\Debug\ExcelWorkbook1. 
D:\Download\Debug\Microsoft. Office. Tools. Common. v4. 0. Utilities. dll 
D:\Download\Debug\Microsoft. Office. Tools. Common. v4. 0. Utilities. xml 
D:\Download\Debug\Microsoft. Office. Tools. Excel. v4. 0. Utilities. dll 

D:\Download\Debug\Microsoft. Office. Tools. Excel. v4. 0. Utilities. xml 


dll 
dll. manifest 


xlsm 


D: \Download\ExcelObject_VSTO_VBA_Setup. nsi 


D:\Download\Lenovob jbxkqd\Lenovobjbxkqd. exe 


3-28 ”递归 遍历 文件 夹 中 的 所 有 内 容 
由 于 namespace 不 只 限于 文件 来， 还 能 把 .zip 压缩 包 当 成 一 个 文件 夹 ， 因 此 下 面 讲 述 遍 


人 国 ”office VBA 开发 经 典 一 中 级 进 阶 郑 


历 .zip 压缩 包 中 的 内 容 。 


3.2.5 ”遍历 .zip 压缩 包 中 的 内 容 


假设 D: 盘 下 有 一 个 “东北 三 省 .zip” 的 压缩 包 ， 其 内 部 文件 结构 如 图 3-29 所 示 。 
时 东 覆 = 宪 zip - winRAR ex) 


文件 (月 ”命令 (Q) 工具 (S) 收藏 夫 (O) 选项 (N) | 帮助 (H) 


ELETIL EE 


E33 
外 国 。 性 #+t= 宪 zip\ 帮 北 = 生 \ 时 克 工 - ZIP 压 六 文件 , 解 包 大 小 为 4 字 ~ 
ETE 7 名 称 大 小 “FEREK 小 类 型 。 | 
就 7 
B RT 目 哈 尔 滨 bt 0 0 文本 文档 
县 吉林 
了 辽宁 
让 大 


EP _ 总 计 0 可 有 (1 个 文 从 


图 3-29 压缩 包 
运行 下 面 的 过 程 ， 可 以 把 压缩 包 中 的 所 有 文件 、 路 径 列 举 出 来 。 


Sub 遍历 压缩 包 中 内 容 () 
Dim ShellApp As New Shell32.Sshell, fd As Shell32.Folder, item As Shell32. 
FolderItem 
With ShellApp 
Set fd = .Namespace("D:\ 东北 三 省 .zip") 
Recursion fd 
End With 
End Sub 


其 中 ，Recursion 是 前 面 讲 过 的 用 于 递归 遍历 的 函数 。 
运行 上 述 程序 ,立即 窗口 打印 出 压缩 包 中 的 所 有 内 容 ， 如 图 3-30 所 示 。 


东北 三 省 . zip 

东北 三 省 

吉林 

D:\ 东 北三 省 . zip\ 东 北三 省 \ 吉 林 \ 长 春 . txt 

D:\ 东 北三 省 . zip\ 东 北三 省 \ 省 份 . tx 

辽宁 

大 连 

D:\ 东 北三 省 . zip\ 东 北三 省 \ 辽 宁 \ 大 连 \ 高 新 区 . txt 
= 三 省 . zip\ 东 北三 省 \ 辽 宁 \ 沈 阳 . txt 

D:\ 东 北三 省 . zip\ 东 北三 省 \ 黑 龙 江 \ 哈 尔 滨 . txt 
Eee 


3-30 递归 遍历 压缩 包 中 的 所 有 内 容 


3.2.6 ”遍历 Office 文档 中 的 内 容 
Office 文档 的 扩展 名 不 是 .zip， 理 论 上 用 Shell32 无 法 遍历 其 内 部 内 容 ， 然 而 ， 可 以 先 
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把 Office 文档 更 改 扩展 名 为 .zip， 等 遍历 完 后 ， 再 撤销 重 命名 即 可 。 
假设 文件 夹 中 有 一 个 幻灯 片 文件 Presentation01.pptx。 下 面 用 Shell32 遍历 该 文件 的 所 有 
内 部 文件 。 


Sub 遍历 Office 文档 () 
Dim ShellApp Rs New Shell32.Shell, fd Rs Shell32.Folder, item Rs Shell32. 
FolderItem 
Dim doc As String 
doc = "C:\temp\Presentation01.pptx" 
Name doc Rs doc & ".zip" 
With ShellApp 
Set fd = .Namespace(doc & ".zip") 
Recursion fd 
End With 
MsgBox " 下面 撤 销 重 命名 ! " 
Name doc & ".zip" Rs doc 
End Sub 


该 幻灯 片 的 内 部 文件 比较 多 ， 因 此 只 打印 出 一 部 分 结果 ， 如 图 3-31 所 示 。 


Presentation01. pptx. 2ip 
C:Ntemp\VPresentation01. pptx. zip\[Content_Types]. xml 


_rels 

C:\temp\Presentation01. pptx. zip\ rels\.rels 

ppt 

slides 

_rels 

C:\temp\Presentation01. pptx. zip\ppt\slides\ rels\slidel. xml. rels 
C:\temp\Presentation01. pptx. zip\ppt\slides\slidel. xml 

_rels 

C:\temp\Presentation01. pptx. zip\ppt\_rels\presentation. xml. rels 


图 3-31 递归 遍历 PPT 文件 中 的 所 有 内 容 
用 WinRAR 打开 该 幻灯 片 ， 如 图 3-32 所 示 。 


泪 peeoneetionolppe WinRAR “下 
文件 月 ” 合 令 C) 工具 (5) 收 茂 赤 D) 于 硕 (N) 各 册 (H) 


ET 


本 站 
是 


转 的 Presentaiion01.pptr -ZIP 语 准 立 村 奶 自 大 小 为 83.304 亨 三 > 
[| 国 presentation0lpptx 匀称 大 小 压 蝙 后 大 小 类 型 

bet | 

ps 下 es E23 | 
ppt ppe 文 # 闪 

[二 Se docProps 文 4 夫 

二 地- DComtent Typeslaml 3.142 429 XML 六 入 

re 
SB deMacters 


EL: 总 计 3 立 竹 才 和 3 142 字 节 上 L 个 六 机 


图 3-32 使 用 压缩 包 查 看 PPT 文件 的 构造 


3.2.7 CopyHere 方 法 


Shell32 中 的 Folder 对 象 有 CopyHere 方法 和 MoveHere 方法 ,作用 是 把 其 他 地 方 的 文件 
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( 夹 ) 复制 或 移动 到 Folder 中 。 
下 面 的 程序 把 dist 路 径 下 的 所 有 文件 、 子 文件 夹 复制 到 temp 路 径 下 。 


Sub 复制 文件 到 文件 夹 中 () 
Dim ShellApp As New Shell32.Shell, fd As Shell32.Folder, data Rs Shell32.Folder 
With ShellApp 
Set fd = .Namespace("C:\temp\") 


Set data = .Namespace("C:\dist\") 
fd.CopyHere data.Items 
End With 
End Sub 


代码 分 析 : data.Items 表示 该 命名 空间 (路 径 ) 下 的 所 有 项 目 ， 包 括 文件 、 子 文件 夹 。 
如 果 要 复制 个 别 的 项 目 ， 需 要 用 Item 属性 来 约定 。 例 如 把 上 面 最 后 一 行 代码 修改 为 如 
下 形式 。 


fd.CopyHere data.Items.item("aaa\ 使 用 说 明 .txt") 


上 述 代码 的 含义 是 把 Ci\dist\aaa\ 使 用 说 明 .txt 这 个 文件 直接 复制 到 temp 文件 夹 下 。 其 
中 ，aaa 是 dist 路 径 下 的 一 个 文件 夹 。 


3.2.8 ”MoveHere 方 法 


MoveHere 方法 与 Copy 方法 几乎 是 一 样 的 语法 ， 唯 一 不 同 的 是 ,使 用 MoveHere 方法 
是 把 文件 或 文件 夹 移动 到 Folder 中 ， 也 就 相当 于 文件 的 移动 、 剪 切 。 

下 面 举 一 个 把 文件 夹 中 的 文件 移动 到 压缩 包 中 的 实例 。 首 先 在 桌面 或 者 任意 文件 夹 中 新 建 
一 个 “WinRAR ZIParchive ”空白 压缩 包 ， 并 把 该 压缩 包 重 命名 为 blankzip， 如 图 3-33 所 示 。 


贞 文件 夹 (月 
看 ”快捷 方式 (S) 
后 Microsoft Access 数据 库 
国 BMP 图 你 
Skin Builder Style Project 
国 联系 人 
本 ”Microsoft Word 文档 
人 回 Dvifle 
癌 国 ”日记 本 文档 
汪 Mindjet MindManager Document 
PE “| 图 wolfram Notebook 
的 “Microsoft powerpoint 演示 文稿 
自 定义 文件 下 转 WinRAR archive 
秆 贴 p) Skin Builder Project 
向 由 快捷 方式 (S) 加 ”ATL MFC Trace Tool settings file 
或 消 重 命名 (U) Cutz | 目 对 并 
-一 的 Microsoft Excel 工作 表 
$09 "| 转 WinRAR ZIP archive 
新 建 (W) 中 重 ”公文 包 
尾 性 (R) 


图 3-33 手工 新 建 一 个 空白 压缩 包 


路 径 C:\temp\datas 下 有 一 百 多 个 文本 文件 ， 如 图 3-34 所 示 。 
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本 
GO an , a%0 ，emp drs E23 
< - 医 艺 


全 部 玖 故 。。 新 建文 件 去 


组 织 ” 包含 到 库 中 v 共享” 


EC 
目 1tet 
四 12 
逢 1aaa 
罩 lata 
目 1sea 
164 
3 
四 la 
罩 l9ea 
轩 2004 
目 21o4 
目 22zea 
罩 2aea 
四 24bt 
目 2sea 


目 26ea 
逢 z7aa 
目 28ot 日 4 
目 29ea 
四 3oot ”日 46oa 
目 3lea 
目 3azea 日 4 
目 33at 


目 42oa 日 ssba 
四 se 
四 6oaa 
目 6lLat 
四 sz 
目 6aat 
四 can 
目 6stt 
seo 
四 erat 
四 can 
目 eoaa 
日 7o%t 
四 7lLaa 
四 ?2 
四 za 


育 和 eB 
用 下载 
LE 


] 100 个 对 象 
四 


图 3-34 文件 夹 中 包含 多 个 文本 文件 


下 面 的 程序 把 datas 文件 夹 连同 其 所 有 子 文件 压缩 到 blank.zip 中 。 


Sub 移动 文件 到 压缩 包 中 () 


Dim ShellApp As New Shell32.Shell, fd As Shell32.Folder, data As Shell32.Folder 


With ShellApp 
Set fd = .Namespace("C:\dist\Blank.zip") 
Set data = .Namespace("C:\temp\datas") 
fd.MoveHere data 
End With 
End Sub 


执行 程序 后 ， 使 WinRAR 软件 查看 压缩 包 blank.zip 中 的 内 容 


， 如 图 3-35 所 示 。 


图 3-35 自动 压缩 文件 夹 


对 Blankzip - WinRAR - es x 
文件 旧 ”命令 (工具 (9) 收 茂 夫 (O) 迁 项 (N) 帮助 (H) 
EA 
测 式 。 走 看 删除 。 查 近 向 信息 时 让 注 彼 
ee 性 Blankzip\datas - ZIP 压缩 文件 , 解 包 大 小 为 2,157,412 字 节 ~ 
晤 Bankap | 口 lt 口 29bdt 45bet 
ts:| D10b¢ 口 15bt D30t¢ D4a6t¢t 
Lj100b¢t D16b¢t D31b¢t 47bt 
D101t¢t 器 174bd 口 32bt 口 48bd 
日 lo2zbd D1l8b¢t 33.txt 49tdt 
日 loatbd 器 1l9bd 34.txt 器 5obd 
目 1loabd D20b¢ 35.bxt 口 5Lbd 
D105t¢t D21b¢t 口 36bd 口 52bd 
日 lo6bd D22b¢ 口 37bd 口 53bd 
日 lo7bd D23b¢t 站 38bd 口 54bd 
日 logbd 目 24bd 39.bd 日 55bd 
日 1o9ba 25b¢t 目 4Lbd 56t¢t 
1Lb¢t 目 26bd 目 42bt 目 57bd 
四 lz 目 2z7sad 目 43bt 目 58bd 
13b¢t 28b¢t 目 44bt 目 59bd 
5 ， 
EF: 总 计 2.157,412 字 生 (99 个 文件 ) 
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需要 注意 的 是 ， 如 果 最 后 一 行 代码 修改 为 如 下 形式 。 
fd.MoveHere data.Items 


执行 的 效果 是 ，datas 下 面 所 有 的 文本 文件 都 直接 压缩 进去 ， 而 没有 datas 这 个 文件 夹 ! 

如 果 修 改 为 {4.MoveHere data.Items.Item("39.txt")， 则 只 把 一 个 文本 文件 移动 到 压缩 包 的 
根 目录 下 。 

反 过 来 ，CopyHere 方法 、MoveHere 方法 也 可 以 从 压缩 包 中 释放 内 容 到 文件 夹 中 。 

下 面 的 程序 把 上 述 有 内 容 的 Blank.zip 中 的 datas\40.txt 文件 移动 到 Ci\lib 路 径 下 。 


Sub 妓 放 压缩 包 中 内 容 到 文件 夹 () 
Dim ShellApp Rs New Shell32.Shell, fd As Shell32.Folder, LIB As Shell32.Folder 
With ShellApp 
Set fd = .Namespace("C:\dist\Blank.zip\datas") 
Set LIB = .Namespace("C:\1lib") 
LIB.MoveHere fd.Items.item("40.txt") 
End With 
End Sub 


代码 分 析 : namespace 允许 在 压缩 包 路 径 后 追加 子路 径 ， 因 此 对 象 变量 f 表示 的 是 压缩 
包 中 的 datas 文件 夹 。 

LIB.MoveHere fd.Items.item("40.txt") 把 中 的 项 目 移动 到 LIB 中 ， 一 定 不 要 搞 错 方向 。 

另外 ,除了 上 述 讲 过 的 用 鼠标 右键 新 建 .zip 压缩 包 之 外 ， 也 可 以 用 代码 自动 在 路 径 下 产 
生 一 个 空白 的 .zip 压缩 包 。 


Sub 新 建 空白 zip 压缩 包 () 
Open "C:\Container.zip" For Output As #1 
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & string(18, 0) 
Close #1 

End Sub 


运行 上 述 过程 ， 会 在 C: 盘 下 产生 Container.zip， 这 个 压缩 包 里 没有 任何 内 容 。 
3.2.9 ”处理 文件 覆盖 


使 用 CopyHere 方 法 、MoveHere 方 法 进行 文件 25%88888@8 
复制 、 移 动 时 ， 如 果 目 的 地 已 经 存在 名 称 相同 的 文 。 | essa 人 
件 ， 执 行程 序 过程 中 会 弹出 是 否 复制 、 替 换 的 对 话 “| ?入 gwenniort 
框 ， 如 图 3-36 所 示 。 ew 

如 果 要 默认 强制 替换 已 存在 文件 ， 屏 项 该 对 话 Ce 


框 ， 可 以 在 方法 之 后 加 一 个 vOptions 参数 ， 并 设置 四 Esa. 将 此 文件 保 吕 在 目标 文人 去 中 : 
为 16。 例如 : ems" 
售 改 日 期 2015/11/3 2232 
fd.CopyHere vItem:=data.Items.item ("aaa\ 使 复制 ， 但 保留 这 两 个 文件 
用 说 明 .txt")，voptions:=16 正 下 提审 的 文件 村 至多 名 为 “使 用 说 明 (2}oq 
这 样 ， 运 行 到 这 行 代码 时 ， 即 使 存在 同名 文件 ， 
也 强制 替换 。 


图 3-36 存在 同名 文件 的 询问 对 话 框 
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3.2.10 “处理 异步 问题 


使 用 CopyHere、MoveHere 方法 移动 内 容 时 ， 不 管 移动 操作 是 否 已 完成 ，VBA 代码 都 
会 继续 向 下 执行 。 如 果 移 动 的 文件 容量 越 大 ， 异 步 问题 越 明 显 。 对 于 一 些 要求 苛 刻 的 程序 任 
务 ， 有 必要 让 程序 同步 压缩 进度 。 

为 了 能 够 让 VBA 识别 到 文件 移动 的 进度 ,需要 在 CopyHere 、MoveHere 方法 之 后 加 一 
个 Do…Loop 循环 ， 循 环 跳出 的 条 件 是 目标 压缩 包 中 的 文件 总 数 达到 一 个 指标 。 

假设 E:\Joker 路 径 下 有 52 张 扑 克 牌 图 片 ， 使 用 下 面 的 程序 把 这 52 个 jpg 格式 的 图 片 全 
部 移动 到 新 建 的 压缩 包 C:\temp\Package.zip 中 。 


Sub 处 理 异 步 问题 () 
Dim ShellApp As New Shell32.Shell, fd Rs Shell32.Folder, data Rs Shell32.Folder 
Open "C:\temp\Package.zip" For Output As #1 
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) 
Close #1 
With ShellApp 
Set fd = .Namespace("C:\temp\Package.zip") 
Set data = .Namespace("E:\Joker") 
fd.MoveHere data.Items, 16 
End With 
Do Until fd.Items.Count = 52 
Application.Wait Now() + TimeValue("00:00:01") 
Loop 
MsgBox " 移动 操作 已 完成 !"， vbInformation 
End Sub 


代码 分 析 : 首先 创建 一 个 空白 .zip 压缩 包 ， 该 压缩 包 中 项 目 个 数 为 0。 其 次 使 用 对 象 
变量 伺 来 指 代 该 压缩 包 ， 然 后 把 Joker 文件 夹 下 的 所 有 文件 移动 到 压缩 包 中 ， 移 动 过 程 中 
fd.Items.Count 一 定 小 于 52， 因 此 根据 这 个 特征 可 以 让 VBA 代码 阻塞 在 Do 循环 内 。 最 后 ， 
压缩 操作 结束 ， 跳 出 Do 循环 ， 弹 出 对 话 框 ， 如 图 3-37 所 示 。 


Microsoft Excel 


0 移动 各 作 已 完成 ! 


图 3-37 压缩 操作 完成 才 弹 出 对 话 框 


3.2.11 修改 Office 文档 功能 区 


Office 2007 以 上 版 本 创建 的 文档 允许 自 定义 功能 区 。 自 定义 功能 区 的 XML 代码 存储 
在 文档 中 CustomUI 文 件 夹 下 ， 文件 名 一 般 为 customUI14.xml。 本 书 源 代码 中 的 example02. 
xlsx 文件 用 WinRAR 打开 后 ， 可 以 看 到 自 定义 功能 区 的 部 分 ， 如 图 3-38 所 示 。 
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转 eampleo2xtsx - WinRAR ch 
文件 (月 ”命令 (Q ”工具 (S) 收 意 夫 (O) 远 项 (N) 帮助 (H) 
Es2 器 鲁 和 钥 验 辐 
添加 解 E 到 测 式 下 看 扣 稚 吉 近 向 信息 
图 的 eampleozxlsacustomul - ZIP 压 斑 文 件 , 解 包 大 小 为 16.623 字 匡 " 川 
国 eampleo2dx 。”[ 硬 - 
rels stomuism | 
上 上 customul 
县 docprops | 
折服 
点 -rels 
上 theme 中 
站 worksheets 
刁 v 居 运 择 384 字 有 (L 个 文 作 总 计 384 字 石 (L 个 文件 ) 


图 3-38 Excel 文件 的 内 部 构造 
双击 customUI14.xml， 可 以 看 到 XML 代码 ， 如 图 3-39 所 示 。 


- <customul xmins="http:/ /schemas.microsoft.com/office/ 2009/07/customui"> 
- <ribbon startFromScratch="false"> 
- <tabs> 
- <tab d="exampleID1" label="RibbonXmlEditor"> 
<group d="GroupID2" label="Author:ryueifu"> 
<button id="ButtonID3" label|=" 原 始 按 角 ”mageMso="ChartTypeOtherInsertGallery” size="large" /> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customul> 


图 3-39 ”customUI 代码 
如 果 在 Excel 中 打开 该 文件 ， 如 图 3-40 所 示 。 


| 导 - 局 于 example02sdsx - Excel 
EE IR  j 虽 页 国人 | RibbonxmlEdhor 


性 


原 治 
EE 
Authorryueifu 
H3 -XxX wv A 
点 B C 了 E 是 6 Bg 1 


图 3-40 包含 customUI 部 分 的 Excel 文件 


下 面 通过 Shell32 的 MoveHere 方法 更 改 XMI 代码 ， 从 而 更 改 功能 区 的 外 观 显示 。 

具体 实现 原理 和 步骤 如 下 。 

(1 ) 在 工作 筹 关 闭 的 前 提 下 ， 后 面 追加 .zip 扩展 名 ， 以 便 Shell32 访问 。 

(2 ) 使 用 MoveHere 方法 把 customUI14.xml 文件 移动 到 某 个 文件 夹 中 。 

(3 ) 使 用 XML 外 部 对 象 自动 修改 文件 夹 中 的 customUI14.xml 文件 。 

(4) 用 MoveHere 方 法 把 文件 夹 中 的 customUI14.xml 文 件 逆 向 移动 回 到 压缩 包 中 的 
customUI 文件 夹 下 。 

(5 ) 删 掉 工 作乱 后 面 的 .zip， 恢 复 为 正常 的 Excel 工作 德 。 具 体 代码 如 下 。 

Sub 修改 office 文档 功能 区 () 


Dim ShellApp As New Shell32.Shell, fd As Shell32.Folder, temp As Shell32.Folder 
Dim wbk As String 
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Dim X Rs New DOMDocument " 引用 Microsoft XML v6.0 
Dim Ribbon Rs String 
wbk = "E:\ 处 理 压缩 文件 \example02.xlsx" 
Name wbk Rs wbk & ".zip" “ 暂时 重 命名 为 .zip 压缩 包 
With ShellApp 
Set fd = .Namespace (wbk & ".zip\customUI") ' 定位 到 压缩 包 中 CustomUI 文件 夹 
Set temp = .Namespace("C:\temp\") 
temp .MoveHere fd.Items .item("customUI14.xml")，16 
" 移动 功能 区 代码 到 磁盘 文件 夹 中 
If X.Load("C:\temp\customUI14.xml") Then " 装载 xml 文件 并 适当 替换 
Ribbon = Replace (X.XML，" 原始 按钮 "，" 被 我 修改 ") 
Ribbon = Replace (Ribbon, "ChartTypeOtherInsertGallery", "M") 
IE X.LoadXML (Ribbon) Then 
X.Save "C:\temp\customUIl14.xml" ' 保存 被 修改 的 xml 文件 
End If 
End If 
fd.MoveHere temp.Items.item("customUIl14.xml"), 16 
' 把 被 修改 的 xml 文件 压缩 回 工作 每 中 
Stop 
End With 
Name wbk & ".zip" Rs wbk " 恢复 原来 的 扩展 名 
End Sub 


代码 分 析 : 为 了 确保 压缩 操作 完成 后 再 重 命名 ， 在 重 命 名 代码 之 前 加 一 个 Stop 语句 。 
运行 上 述 代码 后 ， 在 Excel 2013 中 打开 example02.xlsx 文件 ， 会 看 到 功能 区 中 的 按钮 标 
题 和 图 标 都 发 生 了 变化 ， 如 图 3-41 所 示 。 


甸 日 操 : 避 := example02.xlsx - Excel 
开 hh。 插 和 页面 布局 。 公式。 数 帝 。 市 阅 。 视图 开发 IT 内。 加 加 项 国人 | RibbonXmlEditor 
被 
修改 
Authornueifu 
“|:i[x v £ 


图 3-41 使 用 Shell32 修改 Excel 文件 的 customUI 部 分 
以 上 这 部 分 知识 是 自 定义 功能 区 的 铺垫 ， 同 时 表明 可 以 从 压缩 文件 的 角度 去 研究 和 处 理 
Office 文档 。 
以 上 内 容 的 源 代码 文件 为 “实例 文档 11.xlsm”。 


3.3 本章 小 结 


Shell 调用 WinRAR 处 理 压缩 包 ，Shell32 对 象 处 理 压缩 包 ， 这 些 操作 都 是 异步 的 ， 也 
就 是 说 ，VBA 代码 在 不 知道 压缩 操作 是 否 已 完成 的 情况 下 继续 执行 后 面 的 代码 。 因 此 ， 当 
使 用 CopyHere、MoveHere 方法 之 后 ,需要 补充 一 些 监测 压缩 操作 进度 的 代码 ， 防 止 后 续 的 
VBA 代码 过 早 执行 。 


XML ( Extensible Markup Language) 是 指 可 扩展 性 标记 语言 。1998 年 2 月 ，W3C 正式 
批准 了 可 扩展 性 标记 语言 的 标准 定义 。 可 扩展 性 标记 语言 可 以 对 文档 和 数据 进行 结构 化 处 
理 ， 从 而 能 够 在 部 门 、 客 户 和 供应 商 之 间 交 换 ， 实 现 动 态 内 容 生 成 、 企 业 集 成 和 应 用 开发 。 

通俗 地 讲 ，XML 是 一 种 用 标签 描述 的 数据 格式 、 文 件 格式 。XML 本 身 不 是 编程 语言 ， 
是 一 种 数据 传输 格式 。XML 文件 可 以 存储 各 种 信息 ， 例 如 员工 信息 、 商 品 信息 等 。 

XML 具有 内 容 和 格式 相互 分 离 、 可 扩展 性 等 优势 ， 即 使 是 微软 也 大 量 采 用 XML 技术 
来 开发 Ofice。 前 面 讲 过 ，Of8ce 文档 经 解压 后 可 以 看 出 也 是 由 大 量 XML 文件 组 成 的 。 此 
外 ， 微 软 Office 采用 XML 语言 来 描述 Office 界面 ， 也 允许 用 户 对 Office 界面 进行 自 定义 。 
因此 ， 了 解 和 掌握 XML 语法 对 于 Office VBA 开发 具有 非常 重要 的 意义 。 

本 章 首先 讲述 XML 的 基础 知识 和 语法 规则 ， 然 后 重点 讲述 DOMDocument 对 象 模型 ， 
以 及 使 用 DOMDocument 对 象 读 写 和 修改 XML 的 技术 。 

本 章 用 到 的 外 部 引用 和 重要 对 象 : 

口 Microsoft XML, v6.0 

> MSXML2.DOMDocument60 


4.1 XML 构成 


一 个 典型 的 XML 文件 一 般 由 处 理 指 令 (XML 声明 )、 节 点 树 (NodeTree) 和 一 些 必要 
的 注释 (Comments) 构成 。 

图 4-1 所 示 是 一 个 典型 的 XML 文件 (文件 名 为 “西南 省 份 xsml”) 用 NotePad++ 打开 
后 的 效果 。 

第 1 行 是 该 XML 文件 的 处 理 指令 。 

在 第 2 行 和 第 4 行 中 ，<!-- 与 -> 包 起 来 的 部 分 是 注释 。 

其 余 各 行 用 二 包 起 来 的 部 分 就 是 XML 中 的 标签 ， 也 就 是 元 素 节点 。 
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该 文件 描述 的 是 中 国 西南 各 省 的 首府 城市 、 各 省 人 口 总 数 这 些 信息 。 

XML 文档 模型 中 ， 处 理 指令 、 注 释 、 元 素 、 文 本 内 容 等 都 属于 XML 的 节点 ， 换 句 话 
说 ， 图 中 的 17 行 ， 每 行 都 是 节点 (Node)。 

上 述 XML 文件 如 果 用 Treeview 控件 绘制 一 个 示意 图 ， 将 会 是 如 图 4-2 所 示 的 样子 。 


CELTECO 
1 coxml VerSsioncnI 0OY cncoding-"ute-O"3> x 
< 中 国名 > 日 名 Comtry 
1 “中国 "> 日 - 钨 Province 
5 Capital 
6 <Capital name=" 成 都 "></Capital> ~ Ee 
<population Unit=" 万 人 ">8204</Population> 2 国 Population 
8 </Province> 日 全 Province 
3 <Pprovince 1 " "> 人 
10 <Capita 贵阳 "></capital> Capital 
a <Population Unit=" 万 人 ">3530</Population> 全 > 
12 </Province> i Population 
13 <province name-" 云 南 "> 日 - 侠 pProvince 
14 <Capital r 昆明 "></capital> ~ 
15 <Population Unit=" 万 人 ">4742</Population> 国 Capital 
16 </Province> 局 
3 L</country> |Population 


图 4-1 “西南 省 份 xml” 源 文件 图 4-2 XML 文件 结构 示意 图 
可 以 看 出 ， 该 XML 的 根 元 素 节 点 是 Country， 它 下 面 管辖 3 个 Province 元 素 节 点 ， 每 
个 Province 下 面 有 Capital 和 Population 元 素 节 点 。 
XML 可 以 包含 很 多 种 类 型 的 节点 ， 下 面 分 别 介绍 最 常见 的 节点 类 型 。 


4.1.1 元素 节点 


元 素 ( Element) 节点 ， 是 XML 文件 的 骨架 ， 处 在 数据 存储 的 核心 位 置 。 与 HIML 语 
言 中 的 标签 类 似 ， 元 素 节 点 必须 用 标签 符号 括 起 来 。 

元 素 节点 必须 指定 元 素 的 名 称 ， 例 如 <Staff></Staff> 就 构成 了 一 个 完整 的 元 素 节点 ， 这 
个 元 素 的 名 称 是 Staff。 一 般 情况 下 ， 一 个 元 素 节点 由 开始 标签 和 结束 标签 形成 一 个 闭合 环 
境 。 例 如 : 


<Staff> 


</Staff> 

也 就 是 说 ， 如 果 在 XML 文件 的 某 个 位 置 出 现 了 <Staff>， 在 其 后 面 一 定 有 个 </Staff> 与 
其 呼应 ， 这 个 结束 标签 的 作用 表示 该 标签 就 这 么 大 一 个 作用 范围 。 

元 素 节点 可 以 包含 文本 内 容 、 注 释 、 子 节点 等 ， 也 可 以 什么 都 不 包含 。 

例如 ， 下 面 的 XML 代码 段 中 ，Sta 全 元 素 节点 下 面包 含 一 个 子 元 素 节 点 : 张 三 、 一 个 文 
本 内 容 节 点 (内 容 是 : 技术 部 )， 还 包含 一 个 注释 节点 (内容 是 : 部 分 员工 )。 


<Staff> 


<4== 剖 办 员工 一 > 
</Staff> 
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这 里 可 以 得 出 一 个 结论 : 元 素 节点 可 以 是 其 他 节点 的 父 节 点 ， 同 时 自身 也 可 以 是 其 他 节 
点 的 子 节点 。 

需要 注意 的 是 ， 如 果 某 元 素 节点 下 面 没有 包含 任何 子 节点 ， 其 结束 标签 可 以 合并 到 开始 
标签 中 。 例 如 前 面 的 张 三 元 素 节点 没 包含 任何 子 节点 ， 两 行 可 以 合并 为 < 张 三 户 ， 如 下 所 示 。 


<Staff> 


<4-- 部 分 员工 -=> 
</Staff> 


这 种 元 素 节点 的 合并 方式 通常 用 于 末梢 元 素 中 。 


4.1.2 ”元素 的 属性 


一 个 元 素 节点 ， 可 以 规定 若干 属性 ( attributes)， 每 个 属性 都 由 属性 名 称 和 属性 值 组 成 。 
属性 与 属性 之 间 由 一 个 以 上 的 空格 隔 开 。 无 论 是 任何 类 型 的 属性 值 ， 都 必须 用 引号 括 起 来 。 

元 素 属性 的 语法 格式 如 下 。 

< 元 素 名 称 属性 1="valuel" 属性 2="value2"> 

一 个 元 素 的 所 有 属性 用 空格 隔 开 ， 并 且 这 些 属 性 一 定 和 元 素 的 开始 标签 放 在 同一 个 全 
里 面 。 例 如 下 面 这 句 。 

<Population Unit=" 万 人 ">8204</Population> 

这 个 元 素 节 点 Population 有 1 个 属性 ， 属 性 名 是 Unit， 属 性 值 是 “万 人 ”。 比 较 容易 
混淆 的 是 元 素 的 属性 和 元 素 的 内 容 节点 ,元 素 的 属性 一 定 放 在 元 素 的 开始 标签 中 ， 而 文 
本 内 容 通常 是 夹 在 元 素 的 开始 标签 与 结束 标签 之 间 ， 例如， 本 例 中 的 数字 8204 就 是 元 素 
Population 的 一 个 子 节点 ， 元 素 的 文本 内 容 不 需要 加 引号 。 

元 素 的 属性 值 既 可 以 用 双 引 号 括 起 来 ， 也 可 以 用 单 引 号 括 起 来 。 


4.1.3 ”节点 关系 


要 学 好 XML， 首先 ， 学 会 判断 节点 的 类 型 和 作用 ; 其 次 ， 关 注 节 点 之 间 的 关系 。XML 
的 节点 树 看 起 来 错综复杂 ， 实 际 上 ， 节 点 和 节点 之 间 就 两 种 关系 : 所 属 关系 (父子 关系 ， 
Parent-Child) 与 并 列 关系 (兄弟 关系 ，Sibling)。 正 是 因为 所 属 关 系 和 并 列 关 系 的 存在 ， 才 
形成 了 节点 树 。 

如 果 以 “西南 省 份 xsml ”为 例 ，Country 根 元 素 节点 与 各 个 Province 都 是 父子 关系 ， 而 
Province 之 间 是 兄弟 关系 。 同 一 个 Province 里 面 的 Capital 和 Population 之 间 也 是 兄弟 关系 。 


4.1.4 文本 节点 


文本 节点 ( TextNode) 一 般 是 指 位 于 元 素 节 点 的 起 始 标签 与 结束 标签 之 间 的 文本 内 容 。 
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下 面 的 XML 描述 了 两 种 早餐 的 名 称 、 价 格 、 详 细 信息 和 能 量 。 


<breakfast> 
<food> 
<name>French Toast</name> 
<price>$4.50</price> 
<description>thick slices made from our homemade sourdough bread</description> 
<calories>600</calories> 
</food> 
<food> 
<name>Homestyle Breakfast</name> 
<price>$6.95</price> 
<description>two eggs, bacon or sausage, toast, and our ever-popular 
hash browns</description> 
<calories>950</calories> 
</food> 
</breakfast> 


例如 ，<name>French Toast</name> 中 的 “French Toast” 就 是 一 个 文本 节点 ,该 节点 是 
<name> 元 素 节点 的 子 节点 。 同 理 ,“$4.50” 这 个 文本 节点 的 父 节 点 是 <price> 元 素 节点 。 


4.1.5 注释 节点 


XML 中 的 注释 ( Comment) 内 容 要 放 在 <!-- 与 --> 之 间 ， 一 条 注释 也 构成 了 一 个 
<food> 

<name>French Toast</name> 

<!--This is my favorite food--> 

<price>$4.50</price> 

<description>thick slices made from our homemade sourdough bread</description> 


<calories>600</calories> 
</food> 


例如 ， 上 述 XML 中 的 <!--This is my favorite food--> 是 一 个 注释 节点 ， 其 父 节点 是 
<food> 元 素 节 点 。 兄 弟 节点 有 <name> 、<price> 等 元 素 节点 。 


4.1.6 ”处 理 指令 节点 


处 理 指令 (Processing Instruction) 一 般 书写 于 XML 最 顶端 、 根 元 素 节 点 上 方 的 部 分 。 

如 图 4-1 所 示 ， 顶 部 的 <?xml version="1.0" encoding="utf-8"?> 就 是 处 理 指 令 节点 ， 里 
面包 含 了 XML 的 版 本 、 编 码 方式 等 信息 。 

处 理 指令 节点 是 文档 ( DOMDocument) 的 子 节点 ， 与 根 元 素 ( DocumentElement) 节点 
是 兄弟 关系 。 
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4.2 XML 语法 规则 


XML 文件 与 记事 本 文件 不 一 样 ， 如 果 不 按 规则 书写 XML， 那 么 得 到 的 文件 就 是 不 合法 
的 或 者 形式 不 良好 的 文件 。 


4.2.1 标签 必须 正确 关闭 
这 里 提 到 的 标签 ， 一 般 指 元 素 节 点 的 开始 标签 、 结 束 标 签 。 例 如 下 面 的 语句 来 描述 个 人 信息 。 


<person name="kitty" age="25"> 
这 个 元 素 节点 只 有 开始 标签 ,没有 正确 关闭 ， 有 如 下 两 种 修改 方法 。 
<person name="kitty" age="25"/> 

或 者 


<person name="kitty" age="25"></person> 
4.2.2 ”严格 区 分 大 小 写 


开始 标签 与 结束 标签 必须 是 相同 的 内 容 。 


<staff> 
<person name="kitty" age="25"/> 
<person name="allen" age="27"/> 
</STAFF> 


上 面 的 根 元 素 <staff> 与 结束 标签 中 的 单词 不 对 应 ， 因 此 不 是 一 个 合法 的 XML。 
4.2.3 ”必须 有 根 元 素 


一 个 XML 文件 有 且 只 有 一 个 根 元 素 (DocumentElement)， 该 元 素 节点 是 整个 文档 的 最 
顶层 ， 这 个 根 元 素 可 以 有 很 多 子 节点 ， 但 是 不 能 有 兄弟 元 素 。 
例如 图 4-1 中 的 <Country> 就 是 整个 文档 的 根 元 素 。 


4.2.4 ”父子 元 素 必须 正确 嵌 套 


作为 一 个 父 节点 ， 其 开始 标记 应 位 于 所 有 子 节 点 之 前 ,结束 标记 应 位 于 所 有 子 节点 之 后 。 


<Parent> 
<Child name="kitty" age="25"> 
</Child> 

</Parent> 


以 上 是 一 个 正确 的 父子 节点 内 套 ， 下 面 是 错误 的 嵌 套 方式 。 


<Parent> 
<Child name="kitty" age="25"> 
</Parent> 

</Child> 
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4.2.5 ”属性 值 必须 加 引号 
属性 值 与 文本 内 容 节点 不 同 ， 属 性 值 必须 加 引号 。 


<Parent> 
<Child name="kitty" age=25> 
</Child> 

</Parent> 


以 上 XML 中 的 age 属性 值 未 加 引号 ， 因 此 不 合法 。 应 改 为 : age="25"。 


4.3 查看 和 编辑 XML 


XML 文件 与 HTML 网 页 文件 类 似 ， 可 以 用 记事 本 程序 创建 、 编 辑 ， 可 以 用 网 页 浏览 器 
查看 XML 文件 的 效果 。 
更 专业 的 、 具 有 针对 性 的 XML 编辑 器 还 有 FrontPage、XMLNotepad、XMLSpy 等 软件 。 


4.3.1 使 用 记事 本 程序 创建 XML 文件 


首先 打开 记事 本 程序 ， 新 建 一 个 空白 文档 ， 输 入 XML 代码 。 然 后 关闭 并 保存 这 个 文本 
文件 。 最 后 把 这 个 文本 文件 的 扩展 名 修改 为 .xml 即 可 ， 如 图 4-3 所 示 。 
本 本 十 人 ml -记事 二 cr] 


HD 查看 V) 祁 (H) 
Koxnl version="1.0” encoding="utf-8"?> | 


-中 
《Country name= 市 国 > 
< 中 下列 出 本 南江 和 和 > 


“Provinee name= 
《C 


ce 成都- tal》 
lation Dnit= Be 5 /Populstion> 


-出 >/Capital> 
>》3530</Populetion> 


《Province name=* 云 南 “> 
apital name=“ 昆 明 "> 
《Eopul， ation Unit= A 下 opulation) 
</Province> 
《VCountry》 


图 4-3 用 记事 本 程序 编辑 XML 文件 


注意 ”编辑 过 程 中 ， 尽 量 保持 良好 的 缩 进 ， 避 免 不 必 要 的 空白 行 。 尽 管 不 恰当 的 缩 进 、 
多 余 的 空白 行 不 会 影响 义 ML 的 结构 。 


4.3.2 ”使 用 WebBrowser 控件 显示 XML 


VBA 编程 中 ， 可 以 借助 WebBrowser 控件 发 挥 浏览 器 的 作用 ， 该 控件 可 以 在 VBA 窗 体 
上 显示 网 页 、XML 文件 以 及 .gf 图 片 等 。 

在 VBA 的 用 户 窗 体 的 控件 工具 箱 上 右 击 ， 在 弹出 菜单 中 选择 “附加 控件 ”， 弹 出 附加 
控件 对 话 框 。 
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在 附加 控件 对 话 框 中 旬 选 “Microsoft Web Browser” 或 者 “Microsoft Internet Control”， 
工具 箱 中 会 出 现 一 个 “地 球 ” 图 标的 控件 。 拖 动 该 控件 到 UserForm 上 即 可 ， 如 图 4-4 所 示 。 


Microsoft TabStrip Control, version 5.0 (SP 2 
ID Microsoft Terminal Services Client Control 


内 置 控件 |Activex2 | 
Is A 则 国 国 屎 
a | 
E13 
名 


4-4 用 户 窗 体 使 用 WebBrowser 控件 


然后 添加 一 个 TextBox 控件 ， 用 于 设置 rl， 再 放置 一 个 命令 按钮 ， 并 且 命名 为 “ 显 
示 ”。 命令 按钮 的 单 击 事件 如 下 。 


Private Sub CommandButtonl] Click() 
With Me.WebBrowserl 


.Navigate Me.TextBoxl.Text 
End With 


End Sub 


写 好 代码 后 ， 启 动 窗 体 ， 在 文本 框 中 输入 本 地 XML 文件 的 路 径 ， 单 击 “ 显 示 ” 按 钮 ， 
效果 如 图 4-5 所 示 。 


i ma 


os eonh 开 发 经 负 \ 画 南 省 份 .zal 


<?xml version="1.0" encoding="utf-8" ?> 
<!-- 中 国 各 省 份 --> 
- <Country name=" 中 国 "> 
<L-- 以 下 列 出 西南 地 区 各 省 --> 
- <province name=" 四 川 "> 
<Capital name=" 成 都" /> 
<population Unit=" 万 人 ">8204</Population> 
</Province> 
+ <Province name=" 贵 州 "> 
- <province name=" 云 南 "> 
<Capital name=" 昆 明 " /> 
<population Unit=" 万 人 ">4742</Population> 
</Province> 
</Country> 


| | 


4-5 在 WebBrowser 控件 中 显示 XML 
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4.4 使 用 DOMDocument 读 写 XML 


既然 XML 文件 是 文本 文件 ,那么 当然 可 以 用 文本 文件 读 写 的 方式 对 XML 文件 进行 存 
取 。 微 软 提供 了 专门 针对 XML 的 对 象 模型 DOM ( Document Object Model)， 可 以 对 XML 
进行 全 面 操作 。 


4.4.1 引入 DOMDocument 对 象 


前 期 绑 定 : 在 VBA 工程 中 添加 引用 “Microsoft XML, v 6.0”"， 如 图 4-6 所 示 。 


SI -VeAProjec 
可 合用 的 引用 内 
哨 
Em) 
| 
必 助 00 


Mero WL Wo = 
| 定位 C:MWindows\Systen32\nsxnl6. dll 
标准 


图 4-6 添加 外 部 引用 
添加 该 外 部 引用 后 ， 代 码 中 使 用 
Dim Doc As MSXML2.DOMDocument 
就 声明 了 一 个 对 象 变量 。 
后 期 创建 DOMDocument 对 象 如 下 。 
Set Doc = CreateObject ("MSXML2.DOMDocument") 


下 面 分 别 讲述 把 各 种 来 源 的 XML 载 入 DOMDocument 的 方法 。 


4.4.2 ”装载 本 地 文件 


使 用 DOMDocument 对 象 的 Load 函数 ， 可 以 把 本 地 XML 文件 装载 到 DOM 对 象 模 
型 中 。 
语法 如 下 。 


Load (xmlSource) 


参数 xmlSource 是 指 XML 文件 的 路 径 ， 如 果 装 载 成 功 ，Load 函数 返回 True。 
下 面 的 过 程 装载 本 地 XML 文件 ， 并 在 立即 窗口 打印 文档 对 象 的 XML 代码 。 
Sub OpenLocalXML () 


Dim Doc As MSXML2.DOMDocument 
Set Doc = New DOMDocument 


( 信 ”office VBA 开发 经 典 一 中 级 进 阶 郑 


If Doc.Load (xzmlSource:="E:N\ 西南 省 份 .xzml") Then 
Debug.Print Doc .XML 
End If 
End Sub 


代码 分 析 : 无 论 是 DOMDocument， 还 是 其 他 的 各 种 节点 ， 几 乎 都 有 一 个 XML 属性 ， 
该 属性 返回 的 是 对 象 的 XML 代码 字符 串 。 因 此 可 以 通过 调用 该 属性 来 查看 节点 的 情况 。 


4.4.3 ”装载 网 络 文件 


很 多 情况 下 ， XML 文件 是 网 络 上 的 一 个 远程 文件 ， 此 时 可 以 使 用 XMLhttp 对 象 通过 


URL 请 求 ， 返 回 一 个 responseXML， 然 后 赋 给 DOMDocument 对 象 即 可 。 
下 面 的 代码 从 w3school 网 站 上 获取 一 个 XML 文件 ， 然 后 装载 到 程序 中 的 DOMDocument 
对 象 中 。 


Sub GetRemoteXML () 
Dim DOC As MSXML2 .DOMDocument 
Dim X As MSXML2 .XMLHTTP 
Set X = New XMLHTTP 
With xX 
.Open "GET", "http://www.w3school.com.cn/example/xmle/simple.xml", False 
.send 
Set DOC = .responseXML 
End With 
Debug.Print DOC.XML 
End Sub 


运行 上 述 代码 ， 立 即 窗口 打印 出 XML 文件 的 源 代码 。 
4.4.4 ”装载 字符 串 


除了 使 用 Load 函数 装载 文件 外 ,还 可 以 使 用 LoadXML 函数 直接 装载 程序 中 的 字符 串 。 
下 面 的 过 程 把 程序 中 的 字符 串 装载 到 DOMDocument 中 。 


Sub LoadString () 
Dim DOC As MSXML2 .DOMDocument 
Set DOC = New MSXML2 .DOMDocument 
Dim code As String 
code = "< 天 气 date='2017-12-30"> < 风力 >2-3 级 </ 风力 > < 降水 概率 >60%</ 降水 概率 > 
< 最 低 气温 >10% </ 最 低 气 温 > </ 天 气 >" 
If DOC.LoadXML (code) Then 
Debug.Print DOC .XML 
Else 
MsgBox " 你 的 代码 不 合法 ,装载 失败 ! "，vbExclamation 
End If 
End Sub 


代码 分 析 : 如 果 变 量 code 中 的 字符 串 不 符合 XML 的 语法 规则 ， 会 弹出 “你 的 代码 不 
合法 ， 装 载 失败 ! ”的 警告 对 话 框 。 
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上 述 过 程 运行 后 ， 立 即 窗口 显示 的 运行 结果 如 | 
《天 气 date=”2017-12-30”> 


图 4-7 所 示 。 《风力 ?2-3 级 《/ 风 力 > 
注意 ， 创 建 XML 的 字符 串 中 ， 表 示 元 素 的 属性 时? 


</ 天气 > 


值 时 ， 可 以 用 单 引 号 代替 双 引 号 。 


图 4-7 XML 文档 装载 字符 串 
4.4.5 保存 XML 文件 


不 管 是 从 哪 一 个 来 源 装载 的 DOMDocument， 随 时 都 可 以 使 用 DOMDocument 对 象 的 
Save 方法 保存 为 本 地 XML 文件 。 用 法 如 下 。 


DOC.Save "C:\build\temp.xml" 
其 中 DOC 就 是 一 个 DOMDocument 对 象 ， 运 行 上 述 语句 ， 会 在 指定 路 径 下 生成 一 个 
XML 文件 。 


4.5 DOM 对象 模 型 


XML 文件 的 DOM 对 象 模型 比较 复杂 ， 大 致 的 对 象 模型 如 图 4-8 所 示 。 


DOMDocument 
XML 文 件 


ProcessingInstruction DocumentElement 
处 理 指令 根 元 素 节点 
Element Text Comment 
元 素 节点 || 文本 节点 || 注释 节点 


Attributes 
属性 


图 4-8 XML DOM 对 象 模型 示意 图 
在 图 4-8 中 的 任意 一 个 方 框 都 是 一 个 节点 ， 因 此 ，DOMDocument 是 XML 文件 的 根 节 
点 ，DocumentElement 是 根 元素 节 点 。 其 实 DocumentElement 与 其 他 元 素 节点 没什么 两 样 ， 
不 同 的 是 这 个 节点 的 父 节点 是 DOMDocument。 
因此 ， 在 DOM 对 象 模型 中 ,一切 都 围绕 着 “节点 ”来 展开 讨论 的 ， 一 切 对 象 皆 为 节点 。 


4.5.1 节点 类 型 


XML 文件 的 DOM 对 象 模型 中 的 所 有 节点 的 通用 类 型 是 MSXML2.IXMLDOMNode， 也 
就 是 DOM 节点 对 象 ，DOM 节点 细 分 为 十 多 种 具体 的 节点 类 型 (NodeType)， 如 表 4-1 所 示 。 
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表 4-1 XML 节点 类 型 


节点 类 型 节点 类 型 枚 举 常量 整 数 值 
元 素 节 点 NODE ELEMENT [1 
属性 节点 NODE ATTRIBUTE 2 
文本 节点 NODE TEXT 3 
CDATA 节点 NODE CDATA SECTION 4 
实体 引用 名 称 节点 NODE ENTITY REFERENCE 5 
实体 名 称 节点 NODE ENTITY 6 
处 理 指令 节点 NODE PROCESSING INSTRUCTION 7 
注释 节点 NODE COMMENT 8 
文档 节点 NODE _ DOCUMENT 9 
文档 类 型 节点 NODE _ DOCUMENT _ TYPE 10 
文档 片段 节点 NODE _ DOCUMENT FRAGMENT 11 
DTD 声明 节点 NODE NOTATION 12 


4.5.2 ”节点 对 象 


任意 一 个 节点 都 可 以 声明 为 MSXML2.IXMLDOMNode 对 象 ， 对 应 的 集合 对 象 是 
MSXML2.IXMLDOMNodeList 对 象 ， 可 以 用 来 描述 多 个 节点 组 成 的 集合 


细 分 到 具体 的 节点 类 型 ， 还 可 以 用 下 面 的 对 象 类 型 来 声明 具体 的 


表 4-2 XML 节点 对 象 类 型 
对 象 类 型 
MSXML2.DOMDocument 
MSXML2.IXMLDOMElement 


MSXML2.IXMLDOMAttribute 


节点 ， 如 表 4-2 所 示 


4.5.3 ”节点 对 象 的 属性 


要 了 解 一 个 节点 , 一般 要 看 它 的 NodeName、NodeValue 和 NodeType 属性 ， 这 三 个 属 


MSXML2.IXMLDOMText 


MSXML2.IXMLDOMComment 


MSXML2.IXMLDOMProcessingInstruction 


性 分 别 表示 节点 的 名 称 、 值 和 类 型 。 
此 外 ， 还 可 以 打印 节点 的 XML 属性 ， 更 全 面 地 了 解 一 个 节点 的 信息 。 


4.6 定位 节点 


其 实 ， 学 习 XML 的 DOM 对 象 模型 ， 就 是 为 了 更 方便 地 对 节点 进行 定位 、 读 取 和 修改 
等 操作 。 由 于 XML 是 一 个 树 状 结构 ， 节 点 之 间 有 的 是 并 列 关 系 ， 有 的 是 所 属 关系 ， 准 确定 
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位 到 某 一 节点 ， 通 常 有 很 多 种 方法 。 以 下 介绍 常用 的 定位 方法 。 
4.6.1 使 用 ChildNodes 定位 所 有 子 节点 


XML 文件 中 的 一 个 节点 所 包含 的 子 节点 用 ChildNodes 集 合 对 象 表示 。 
XxxX.ChildeNodes(0) 就 表示 xx 节点 的 首 个 子 节点 。 

仍然 以 “西南 省 份 .sml” 为 例 ， 该 文档 对 象 直属 子 节点 有 3 个 ， 即 处 理 指令 节点 、 注 
释 节点 和 根 元 素 节点 。XML 代码 如 下 。 


<?xml version="1.0" encoding="utf-8"?> 
<!-- 中 国 各 省 份 --> 
<Country name=" 中 国 "> 
<!-- 以 下 列 出 西南 地 区 各 省 --> 
<Province name=" 四 川 "> 
<Capital name=" 成 都 "></Capital> 
<Population Unit=" 万 人 ">8204</Population> 
</Province> 
<Province name=" 贵州 "> 
<Capital name=" 贵阳 "></Capital> 
<Population Unit=" 万 人 ">3530</Population> 
</Province> 
<Province name=" 云南"> 
<Capital name=" 昆明 "></Capital> 
<Population Unit=" 万 人 ">4742</Population> 
</Province> 
</Country> 


下 面 的 过 程 遍历 文档 对 象 的 所 有 子 节点 (只 包括 直属 子 节点 ， 不 包括 孙 节 点 等 )。 


Sub LoopAllNodes () 
Dim DOC Rs MSXML2.DOMDocument 
Dim ND As MSXML2 .IXMLDOMNode 
Set DOC = New DOMDocument 
If DOC.Load (xmlSource:="E:\ 西南 省 份 .xzml") Then 
Debug.Print "节点 名 称 "，" 节点 类 型 "，" 节点 值 " 
For Each ND In DOC.ChildNodes 
Debug.Print ND.nodeName, ND.NodeType, ND.NodeValue 
Next ND 
End If 
End Sub 


代码 分 析 : 由 于 各 个 子 节点 的 类 型 不 一 样 ， 因 此 代码 中 的 对 象 变量 ND 需要 声明 为 通用 
类 型 .XMLDOMNode， 而 不 能 是 XMLDOMElement。 
运行 上 述 过 程 ， 在 立即 窗口 打印 各 子 节点 的 名 称 、 类 型 和 值 ， 如 图 4-9 所 示 。 


攻 
节点 名 称 节点 类 型 节点 值 
Xml 了 


version=”1.0” encoding=”"utf-8” 
中 国 各 省 份 


#comment 8 
Country 1 Null 


图 4-9 遍历 子 节点 
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需要 注意 的 是 ， 在 VBA 中 DOM 对 象 模型 的 集合 都 是 以 0 作为 第 一 个 子 成 员 的 下 标 。 
此 外 ， 节 点 下 面 的 FirstChild 也 可 以 定位 到 第 一 个 子 节点 ， 它 等 价 于 ChildNodes(0)， 相 对 应 
地 ，LastChild 可 以 定位 到 最 后 一 个 子 节点 。 


4.6.2 ”使 用 PreviousSibling 和 NextSibling 定位 前 后 节点 


PreviousSibling 与 NextSibling 表示 与 节点 并 列 的 其 他 节点 ， 分 别 表示 前 一 个 节点 和 后 


一 个 节点 。 
“西南 省 份 .xsml” 中 的 根 元 素 节 点 是 <Country>， 该 节点 下 面包 含 4 个 子 节点 ， 分 别 是 
注释 节点 和 3 个 元 素 节 点 。 下 列 过 程 用 于 获取 兄弟 节点 。 


Sub 获取 兄弟 节点 () 
Dim DOC As MSXML2 .DOMDocument， Root As MSXML2.IXMLDOMElement 
Dim ND(1 To 3) As MSXML2.IXMLDOMElement 
Set DOC = New DOMDocument 
If DOC.Load (xmlSource:="E:\ 西南 省 份 .xml") Then 
Set Root = DOC.DocumentElement 


Debug.Print Root.ChildNodes.Length " 打印 根 元 素 节 点 的 子 节点 总 数 
Set ND(2) = Root.ChildNodes (2) 

Set ND(1) = ND(2) .PreviousSibling 

Set ND(3) = ND(2) .NextSibling 


Debug.Print ND(1) .XML 
Debug.Print ND(3) .XML 
End If 
End Sub 


代码 分 析 : 本 例 中 NDO 是 一 个 数组 ， 分 别 表示 3 个 Province， 由 于 这 3 个 都 是 元 素 节 
点 ， 因 此 数组 的 类 型 可 以 声明 为 具体 的 IXMLDOMElement。 
上 述 程序 的 运行 结果 如 图 4-10 所 示 。 


立即 窗口 
4 
《Province name=” 四 川 “> 
《Capital name=“ 成 都 >《/Capital》 
《Population Unit=“ 万 人 “38204</Population>》 


</Province> 
《Province name=” 云 南 > 
《Capital name=” 昆 明 ”>《/Capital>》 
《Population Unit=” 万 人 “4742</Population> 
</Province> 


图 4-10 获取 兄弟 节点 


4.6.3 使 用 ParentNode 定位 父 节点 


与 ChildNodes 对 应 的 是 ParentNode，ParentNode 是 指 当 前 节点 的 上 一 级 节点 。 由 于 任 
一 节点 的 父 节 点 只 能 是 一 个 ， 所 以 该 单词 后 面 没有 s。 

仍然 以 “西南 省 份 xml” 为 例 。 

在 下 面 的 过 程 中 ， 首 先 定位 到 根 元 素 下 面 的 第 0 个 子 节 点 ， 这 是 一 个 注释 节点 。 然 后 以 
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注释 节点 为 基准 ， 依 次 回溯 其 上 级 节点 。 


Sub 获取 父 级 节点 () 
Dim DOC As MSXML2 .DOMDocument, Root As MSXML2 .IXMLDOMElement 
Dim ND As MSXML2 .IXMLDOMNode 
Set DOC = New DOMDocument 
If Doc.Load (xmlSource:="E:\ 西南 省 份 .xml") Then 
Set Root = DOC.DocumentElement 
Set ND = Root.FirstChild 
Debug.Print ND.nodeName, ND.ParentNode.nodeName, ND.ParentNode.ParentNode. 
nodeName 
End If 
End Sub 


代码 分 析 : ND 是 一 个 注释 节点 ， 其 上 级 是 根 元 素 节点 Country， 再 上 一 级 就 是 文档 
对 象 。 
运行 上 述 过 程 ， 打 印 结果 如 下 。 


#comment Country #document 


注意 如 果 从 XML 中 的 任 一 节点 直接 获取 根 元 素 节点 (祖先 节点 )， 可 以 使 用 
ownerDocument， 不 需要 反复 使 用 ParentNode。 


4.6.4 ”使 用 XPath 定位 到 任 一 节点 

虽然 在 实际 编程 中 经 常 使 用 ChildNodes 定位 子 节点 , 但 是 如 果 一 个 XML 的 嵌 套 层 数 
非常 多 ， 需 要 多 次 用 到 ChildNodes， 这 时 定位 就 显得 麻烦 了 。 

下 面 介 绍 使 用 XPath 指定 一 个 路 径 ， 从 指定 节点 一 步 到 达 定位 的 深层 节点 。 常 用 的 节点 
定位 的 XPath 写法 如 表 4-3 所 示 。 


表 4-3 XPath 常用 表示 形式 及 其 含义 


XPath 含 党 
/Country/Province/Capital 从 根 元 素 开始 ， 逐 级 查找 子 节点 。 属 于 绝对 路 径 
//Population 从 当前 节点 开始 ， 查 找 所 有 名 称 为 Population 的 子 节点 
/Province/Capital[@name=' 昆明 ] | 从 当前 节点 开始 ， 查 找 所 有 Capital 子 节点 (name 属性 必须 是 昆明 ) 
/Province[Population<5000] 查找 所 有 Population 的 文本 小 于 5000 的 Province 节点 
/Province[Population<5000]/Capital | 查找 所 有 Population 的 文本 小 于 5000 的 Province 下 面 的 Capital 子 节点 
/Country/* 查找 Country 之 下 的 所 有 元 素 节点 (不 包括 其 他 类 型 节点 ) 
/Country/Province/@* 查找 Province 的 所 有 属性 节点 
/Country/nodeO 查找 Country 之 下 的 所 有 类 型 的 子 节点 


更 多 XPath 的 高 级 用 法 ， 请 参阅 其 他 资料 。 
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1. 使 用 SelectSingleNode 获取 第 一 个 符合 路 径 的 节点 
下 面 的 过 程 使 用 绝对 路 径 的 方式 查找 到 第 一 个 名 称 为 Capital 的 元 素 节点 。 


Sub XPathl () 
Dim DOC As MSXML2 .DOMDocument, Root As MSXML2 .IXMLDOMElement 
Dim ND As MSXML2 .IXMLDOMNode 
Set DOC = New DOMDocument 
If DOC.Load (xmlSource:="E:\ 西南 省 份 .xml") Then 
Set Root = DOC.DocumentElement 
Set ND = Root.SelectSingleNode("/Country/Province/Capital") 
Debug.Print ND.XML 
End If 
End Sub 


代码 分 析 : /Country/Province/Capital 是 一 个 XPath， 表 示 从 根 元 素 开始 ， 逐 级 定位 ， 一 
直 查 到 Capital 为 止 。 虽 然 本 例 中 的 XML 文件 中 有 3 个 Capital 节点 ,但 是 程序 中 用 的 是 
SelectSingleNode 方法 ， 因 此 找到 第 一 个 即 可 。 

运行 上 述 过 程 ， 打 印 结果 如 下 。 


<Capital name=" 成 都 "></Capital> 


2. 使 用 SelectNodes 获取 所 有 符合 路 径 的 节点 集合 
SelectNodes 方法 返回 的 是 多 个 节点 构成 的 集合 ， 因 此 需要 声明 为 XMLDOMNodeList 
类 型 。 


Sub XPath2 () 
Dim DOC As MSXML2 .DOMDocument， Root As MSXML2.IXMLDOMElement 
Dim NL As MSXML2 .IXMLDOMNodeList，ND Rs MSXML2 .IXMLDOMNode 
Set DOC = New DOMDocument 
If DOC.Load (xmlSource:="E:\ 西南 省 份 .xzml") Then 
Set Root = DOC.DocumentElement 
Set NL = Root.SelectNodes ("/CountrYy/Province/Capital") 
For Each ND In NL 
Debug.Print ND.XML 
Next ND 
End If 
End Sub 


代码 分 析 : 对 象 变量 NL 获取 了 多 个 符合 该 路 径 的 节点 ， 因 此 还 需要 用 For 循环 遍历 每 
个 子 节 点 的 信息 。 
运行 上 述 过 程 ， 打 印 结果 如 下 。 


<Capital name=" 成 都 "></Capital> 
<Capital name=" 贵阳 "></Capital> 
<Capital name=" 昆明 "></Capital> 


4.6.5 使 用 getElementsByTagName 定位 到 一 组 元 素 节点 


ge 三 lementsByTagName 方法 是 以 当前 节点 为 基准 ， 查 找 指定 名 称 的 所 有 元 素 节 点 。 
下 面 的 过 程 从 文档 对 象 开 始 查找 所 有 Population 元 素 节点 。 
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Sub GetByTagName () 
Dim DOC Rs MSXML2 .DOMDocument， Root Rs MSXML2 .IXMLDOMElement 
Dim NL As MSXML2 .IXMLDOMNodeList，ND As MSXML2 .IXMLDOMNode 
Set DOC = New DOMDocument 
If DOC.Load (xmlSource:="E:\ 西南 省 份 .xzml") Then 
Set Root = DOC.DocumentElement 
Set NL = DOC.getElementsByTagName ("Population") 
For Each ND In NL 
Debug.Print ND.XML 
Next ND 
End If 
End Sub 


代码 分 析 : 这 个 实例 的 功能 等 价 于 XPath 中 的 //Population。 
运行 上 述 过 程 ， 打 印 结果 如 下 。 


<Population Unit=" 万 人 ">8204</Population> 
<Population Unit=" 万 人 ">3530</Population> 
<Population Unit=" 万 人 ">4742</Population> 


4.6.6 使 用 getAttributeNode 定位 到 属性 


元 素 节 点 的 getAttributeNode 方法 可 以 定位 到 元 素 中 的 某 一 属性 ， 返 回 一 个 属性 节点 。 


Sub GetByAttributeNode() 
Dim DOC Rs MSXML2 .DOMDocument， Root As MSXML2 .IXMLDOMElement 
Dim A As MSXML2.IXMLDOMAttribute 
Set DOC = New DOMDocument 
IE DOC.Load (xmlSource:="E:\ 西南 省 份 .xml") Then 
Set Root = DOC.DocumentElement 
Set A = Root.getAttributeNode ("name") 
Debug.Print A.nodeName, A.NodeValue, A.NodeType 
End If 
End Sub 


代码 分 析 : 代码 中 的 Root 是 根 元 素 节点 ( Country)， 对 象 变量 A 是 一 个 属性 节点 ， 表 
示 Country 元 素 的 name 属性 。 
运行 上 述 过 程 ， 打 印 结 果 如 下 。 


name 中 国 2 


注意 属性 一 般 书写 在 元 素 节 点 的 开始 标签 ， 但 是 每 一 个 属性 并 非 元 素 节 点 的 子 节点 ， 
因此 元 素 与 属性 之 间 的 关系 不 能 通过 ChildNodes 或 者 ParentNode 来 描述 。 


以 上 内 容 的 源 代码 文件 为 “实例 文档 12.xlsm”。 


4.7 详细 了 解 元 素 节 点 


元 素 节点 是 构成 XML 树 状 结构 的 骨架 ， 可 以 说 文本 节点 、 注 释 节点 、 属 性 等 都 附着 于 
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元 素 节 点 。 因 此 ， 从 一 个 元 素 节点 出 发 ， 获 取 与 该 元 素 有 关 的 其 他 节点 、 属 性 具有 非常 重要 
的 意义 。 

一 个 元 素 节点 往往 具有 它 的 父子 、 兄 弟 节点 ， 这 些 前 面 已 经 介绍 过 ， 本 节 重 点 讲述 元 素 
节点 下 面包 含 的 属性 、 子 元 素 、 文 本 节点 和 注释 节点 。 

本 节 案 例 一 律 基于 “华北 地 区 .xml” 文 件 ， 如 图 4-11 所 示 。 


<Country name=" 中 国 "> 
<Area name=" 华 北 地 区 "> 
<Province name=" 河 北 "> 
<Capital name=" 石 家 庄 "/> 
</Province> 
<Province name=" 内 蒙古 " eng="Inner Mongolia" shortname=" 蒙 "> 


<City name=" 呼 和 浩特 "/> 
<!-- 区 号 : 0471 --> 
稀土 之 都 
<City name=" 包 头 "/> 
<!-- 区 号 : 0472 --> 
塞外 小 北京 
<City name=" 巴 彦 浩特 "/> 
<!-- 区 号 : 0483 --> 
</Province> 
<Province name=" 山 西 "> 
<Capital name=" 太 原 "/> 
</Province> 
</Area> 
</Country> 


图 4-11 “华北 地 区 .xml” 文 件 内 容 


首先 熟悉 一 下 文件 结构 ， 第 一 个 Province 元 素 名 称 是 “内 蒙古 "， 该 节点 的 父 级 节点 是 
Area， 祖先 节 点 是 Country。 
Province 元 素 节点 包含 3 个 属性 、3 个 文本 节点 、3 个 子 元 素 节 点 (City)、3 个 注释 节点 。 


4.7.1 ”遍历 元 素 的 属性 


元 素 节点 的 属性 ， 使 用 Attributes 集合 对 象 描述 。 用 For 循环 可 以 遍历 每 一 个 属性 的 名 
称 和 值 。 

下 面 的 过 程 首先 用 XPath 定位 到 内 蒙古 这 个 Province 元 素 节 点 ， 然 后 打印 该 节点 的 所 
有 属性 。 


Sub GetAllAttributes() 
Dim DOC As MSXML2 .DOMDocument 
Dim province As MSXML2 .IXMLDOMElement 
Dim attr Rs MSXML2 .IXMLDOMAttribute 
Set DOC = New DOMDocument 
If DocC.Load (xmlSource:="E:\ 华北 地 区 .xml") Then 
Set province = DOC.SelectSingleNode ("/Country/Rrea/Province [ename=' 内 蒙古 ']") 
For Each attr In province.Attributes 
Debug.Print attr.Name, attr.Value 
Next attr 
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Debug-Print " 下面 只 获取 eng 属性 " 
Debug.Print province.getAttribute ("eng") 
End If 
End Sub 
代码 分 析 : 由 于 需要 从 Attributes 集 合 中 遍历 ， 因 此 循环 变量 attr 需 要 声明 为 
IXMLDOMAttribute 类 型 。 
"/Country/Area/Province[@name=' 内 蒙古 表示 用 绝对 路 径 找到 Province 元 素 节 点 ， 
并 日 name 属性 必须 等 于 “内 蒙古 ”。 另 外 ，XPath 也 可 以 写作 "/Country/Area/Province[1]"， 
表示 找到 的 所 有 Province 节点 中 只 选取 第 1 个 ， 


也 就 是 内 蒙古 的 那个 Province。 name 内 蒙古 _ 
如 果 要 单独 获取 某 一 属性 ， 可 以 使 用 节点 的 “| spg ne。 要 ner engolia 
getAttribute 函数 。 下 面 只 获取 eng 属 性 
Inner Mongolia 
运行 上 述 过 程 ， 立 即 窗口 的 结果 如 图 4-12 
所 示 。 图 4-12 遍历 元 素 的 属性 


4.7.2 ”遍历 元 素 的 文本 节点 


元 素 节 点 下 面 经 常 包含 多 种 不 同类 型 的 子 节点 ， 因 此 在 ChildNodes 里 面 遍历 时 ， 需 
要 用 通用 的 节点 类 型 [XMLDOMNode， 如 果 只 遍历 文本 节点 ， 还 需要 使 用 NodeType 或 
NodeTypeString 判断 一 下 。 

下 面 的 过 程 遍历 Province 的 3 个 文本 节点 。 


Sub GetAllTextNodes() 
Dim DOC Rs MSXML2 .DOMDocument 
Dim province As MSXML2 .IXMLDOMElement 
Dim node As MSXML2 .IXMLDOMNode 
Dim T As MSXML2 .IXMLDOMText 
Set DOC = New DOMDocument 
Doc.Load xmlSource:="E:\ 华北 地 区 .xml" 
Set province = DOC.SelectSingleNode ("/Country/Rrea/Province [ename=' 内 蒙古 ']") 
For Each node In province.ChildNodes 
If node.NodeType = NODE TEXT Then 
Set T = node 
Debug .Print T.nodeName, T.nodeTypeString, T.NodeValue 
End If 
Next node 
End Sub 


代码 分 析 : NodeType 是 一 个 枚 举 常 量 值 (整数 值 )， 与 其 对 条 宇都 
应 的 是 NodeTypeString (字符 串 )， 这 两 个 都 可 以 用 来 判断 节点 的 it 
类 型 。 塞外 小 北京 


运行 上 述 过 程 ， 立 即 窗口 的 结果 如 图 4-13 所 示 。 图 4-13 遍历 文本 节点 


#text 
青 城 
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4.7.3 ”遍历 元 素 的 子 元 素 节 点 


遍历 子 元 素 节点 时 ， 只 需要 判断 NodeType 是 否 等 于 NODE ELEMENT，, 或 者 
NodeTypeString 是 否 等 于 “element” 即 可 。 
下 面 的 过 程 判断 Province 下 面 的 3 个 City 子 元 素 节点 。 


Sub GetAllElements() 
Dim DOC As MSXML2 .DOMDocument 
Dim province Rs MSXML2.IXMLDOMElement 
Dim node Rs MSXML2.IXMLDOMNode 
Dim E As MSXML2.IXMLDOMElement 
Set DOC = New DOMDocument 
DOC.Load xmlSource:="E:\ 华北 地 区 .xml" 
Set province = DOC.SelectSingleNode ("/Country/RArea/Province [ename=' 内 蒙古 ']") 
For Each node In province.ChildNodes 
If node.NodeType = NODE ELEMENT Then 
Set E = node 
Debug .Print E.nodeName, E.nodeTypeString, E.XML 
End If 
Next node 
End Sub 


运行 上 述 过 程 ， 立 即 窗 口 的 结果 如 图 4-14 所 示 。 


element 《City name=“ 呼 和 浩特 ”/》 


element 《City name=" 包 头 /》 
element 《City name=" 巴 彦 浩特 /> 


图 4-14 遍历 子 元 素 节 点 


4.7.4 ”遍历 元 素 的 注释 节点 


针对 IXMLDOMElement 对 象 ，nodeName 的 属性 是 #comment， 通 过 访问 data 属性 可 以 
获得 注释 符号 里 面 的 内 容 。 


Sub GetAllComments () 
Dim DOC As MSXML2 .DOMDocument 
Dim province As MSXML2.IXMLDOMElement 
Dim node As MSXML2 .IXMLDOMNode 
Dim C Rs MSXML2.IXMLDOMComment 
Set DOC = New DOMDocument 
DOC.Load xmlSource:="E:\ 华北 地 区 .xml" 
Set province = DOC.SelectSingleNode ("/Country/Rrea/Province [ename=' 内 蒙古 ']") 
For Each node In province.ChildNodes 
If node.NodeType = NODE COMMENT Then 
Set C = node 
Debug.Print C.nodeName, C.nodeTypestring, C.Data 
End If 
Next node 
End Sub 
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运行 上 述 过 程 ， 立 即 窗 口 的 结果 如 图 4-15 


#comment comment 8: O47 
示 # t t 区 号 : 0472 
所 示 。 et elt 区 号 : 0483 
图 4-15 遍历 注释 节点 
4.8 创建 和 修改 XML 


前 面 讲解 的 都 是 基于 现 有 的 XML 文件 来 读 取 内 容 信息 。 在 实际 编程 应 用 中 ， 经 常 需要 
对 现 有 XML 中 的 部 分 内 容 进行 修改 ， 或 者 完全 从 头 创建 一 个 XML。 


4.8.1 创建 节点 


XML 文件 中 的 一 切 都 是 节点 ， 只 不 过 各 个 节点 类 型 不 同 而 已 。DOMDocument 对 象 下 
面 有 一 些 以 create 开头 的 方法 ， 这 些 方法 用 于 创建 各 种 类 型 的 节点 。 

口 createAttributeCname): 创建 一 个 指定 属性 名 称 的 属性 。 

口 createComment(data): 创建 一 个 注释 ， 注 释 的 内 容 为 data。 

口 createElement(tagName): 用 于 创建 一 个 指定 名 称 的 元 素 节点 。 

口 createNode(type,name,namespaceURT): 创建 一 个 指定 节点 类 型 和 节点 名 称 的 节点 。 

口 createProcessingInstruction(target,data): 创建 一 个 处 理 指令 。 

口 createTextNode(data): 创建 一 个 文本 节点 ， 内 容 为 data。 

其 中 ，createAttribute 方法 返回 一 个 属性 对 象 ， 该 属性 对 象 不 能 用 AppendChild 等 方法 


插入 元 素 中 ， 因 为 属性 不 是 元 素 节点 的 子 节点 。 
下 面 的 过 程 用 于 分 别 创建 以 上 6 种 类 型 的 节点 。 
Sub 创建 节点 () 
Dim DOC Rs MSXML2.DOMDocument " 声明 文档 对 象 
Dim attr As IXMLDOMAttribute ' 声明 一 个 属性 变量 
Dim comment Rs IXMLDOMComment " 声明 一 个 注释 变量 
Dim element Rs IXMLDOMElement " 声明 一 个 元 素 变量 
Dim node As IXMLDOMNode " 声明 一 个 通用 节点 
Dim instruction As IXMLDOMProcessingInstruction " 声明 一 个 处 理 指令 
Dim text Rs IXMLDOMText " 声明 一 个 文本 节点 
Set DOC = New MSXML2.DOMDocument ' 新 建 一 个 XML 文档 
With DOC 
Set attr = .createAttribute ("age") " 创建 一 个 属性 节点 
attr.Value = "36" " 设置 属性 值 


Debug.Print attr.XML 


Set comment = .createComment (" 去 年 的 信息 ") ' 创建 一 个 注释 节点 
Debug.Print comment .XML 


Set element = .createElement ("staff")  ' 创建 一 个 名 称 为 staff 的 元 素 节点 
element .setAttribute "name", "yongfu liu™ 

element .setAttribute "gender", "male" 

Debug.Print element .XML 


Set node = .createNode (Type:=MSXML?2 .NODE ELEMENT, Name:="manager", 


人 俩 office VBA 开发 经 典 一 中 级 进 阶 郑 


NamespaceURI:="") 
Debug.Print node.XML 


Set instruction = .createProcessingInstruction("xml", " version="'1.0" 
encoding="'utf-8'") 
Debug.Print instruction.XML 


Set text = .createTextNode ("This is a message") 
Debug.Print text.XML 
End With 


End Sub 


代码 分 析 : 每 创建 一 个 节点 ， 就 打印 该 节 


age=”36” 


点 的 代码 。 但 是 由 于 这 些 节点 均 未 附加 到 DOC ”| 2 二 -去 年 的 信息 一 > 


《staff name= "yongfu liu” gender="male”/> 


中 ， 因 此 未 形成 一 个 完整 的 XML 节点 树 。 Sonor a rn 
运行 上 述 过 程 ， 立即 窗口 打印 出 各 个 节点 This is a message 
的 XML 代码 ， 如 图 4-16 所 示 。 图 4-16 创建 各 种 类 型 的 节点 


4.8.2 ”插入 节点 


创建 了 的 节点 尚未 出 现在 XML 文档 中 ， 必 须 通 过 AppendChild 方法 或 InsertBefore 方 
法 把 节点 作为 XML 文档 已 有 节点 的 子 节点 插入 。 

例如 A.AppendChild B， 表 示 把 B 节点 成 为 A 节点 的 子 节点 ， 如 果 A 中 已 经 有 子 节 点 ， 
那么 B 被 放 到 最 后 位 置 。 

InsertBefore 方法 与 AppendChild 类 似 , 不同 的 是 该 方法 可 以 指定 插入 的 位 置 。 例 如 : 
A.InsertBefore B,C 表示 C 已 经 是 A 的 一 个 子 节点 了 ， 接 下 来 要 把 B 也 作为 A 的 子 节点 , 但 
是 要 放 在 C 之 前 。 

节点 之 间 通 过 反复 使 用 AppendChild 这 些 方法 ， 就 把 零散 的 节点 形成 了 节点 树 。 

下 面 的 过 程 把 创建 的 各 个 节点 组 织 成 一 个 完整 的 XML 文件 。 


Sub 播 入 节点 () 
Dim DOC Rs MSXML2.DOMDocument " 声明 文档 对 象 
Dim attr As IXMLDOMAttribute ' 声明 一 个 属性 变量 
Dim comment Rs IXMLDOMComment ' 声明 一 个 注释 变量 
Dim element As IXMLDOMElement ' 声明 一 个 元 素 变量 
Dim node Rs IXMLDOMNode " 声明 一 个 通用 节点 
Dim instruction As IXMLDOMProcessingInstruction '， 声明 一 个 处 理 指令 
Dim text As IXMLDOMText " 声明 一 个 文本 节点 
Set DOC = New MSXML2.DOMDocument " 新 建 一 个 XML 文档 
With DOC 
Set attr = .createAttribute ("age") ' 创建 一 个 属性 节点 
attr.Value = "36" " 设置 属性 值 


Set comment = .createComment (" 去 年 的 信息 ") ' 创建 一 个 注释 节点 
Set element = .createElement ("staff") “' 创建 一 个 名 称 为 staff 的 元 素 节点 


element.setAttribute "name", "yongfu liu™ 
element.setAttribute "gender", "male™ 
Set node = .createNode (Type:=MSXML2 .NODE ELEMENT, Name:="manager", 


NamespaceURI:="") 


encoding="'utf-8'") 


End 
End Sub 


运行 上 述 过 程 ， 使 用 浏览 器 阅览 XML 文 
件 ， 效果 如 图 4-17 所 示 。 
可 以 看 出 ， 文 本 节点 出 现在 注释 节点 上 
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Set _ instruction = .createProcessingInstruction("xml", " Version="1.0" 
Set text = .createTextNode ("This is a message") 

" 以 上 创建 节点 完毕 

element.setAttributeNode attr " 把 age 属性 添加 到 staff 元 素 节 点 中 

element .appendChild node ' 把 manager 元 素 节 点 作为 staff 元 素 的 子 节点 
element .appendChild comment " 把 注释 节点 作为 staff 元 素 的 子 节点 


element .InsertBefore text, comment 


" 把 文本 节点 作为 staff 元 素 的 子 节点 ， 但 是 插入 到 注释 节点 之 前 
DOC.appendChild element 'staff 元素 作 为 文档 对 象 的 子 节点 ， 也 就 是 作为 根 元 素 节点 


DOC.InsertBefore instruction, DOC.FirstOl 


hild 


" 把 处 理 指令 插入 到 DOC 首 个 子 节点 之 前 ， 也 就 是 处 理 指令 置顶 


' 以 上 插入 节点 完毕 

Debug.Print DOC.XML 

DOC.Save ThisWorkbook.Path & "\temp . xml" 
With 


<?xml Vi 


- <staff name="yongfu liu" gender="male" age="36"> 
<manager /> 
This is a message 
<!-- 去 年 的 信息 --> 
</staff> 


ersion="1.0" ?> 


方 ， 这 体现 了 InsertBefore 的 作用 。 


4.8.3” 移 除 节点 
移 除 节 点 与 插入 节点 恰恰 相反 ， 是 从 节点 中 移 除 一 个 子 节点 ， 可 以 使 用 RemoveChild 


方法 。 例 如 : 


图 4-17 插入 节点 


A.RemoveChild A.FirstChild 表示 把 A 的 第 0 个 子 节点 移 除 。 
A.RemoveChild A.ChildNodes(1) 表示 把 A 的 第 1 个 子 节点 移 除 。 


4.8.4 ”修改 和 移 除 节 点 的 属性 


添加 、 修 改元 素 节点 的 属性 ， 使 用 setAttribute 方 法 ; 移 除 已 有 的 属性 ， 使 用 
removeAttribute 方法 。 


Sub 修改 和 移 除 元 素 节点 的 属性 () 
Dim DOC Rs MSXML2.DOMDocument 
Dim Elem As MSXML2 .IXMLDOMElement 
Set DOC = New DOMDocument 
Set Elem = DOC.createElement ("Staff") 
Elem.setAttribute "name", "John™" ' 添加 name 属性 
Elem.setAttribute "hobby", "Music" 
Elem.setAttribute "age", "25" 


Elem.setAttribute "hobby"， "Traveling 
Elem.removeAttribute "age 


Debug.Print Elem.XML 


End Sub 


运行 上 述 过程 ， 立 即 窗口 的 输出 结果 如 下 。 


' 创建 一 个 元 素 节点 


' 添加 hobby 属性 
“添加 age 属性 
' 修改 hobby 属性 
' 移 除 age 属性 
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<Staff name="John"” hobby="Traveling"/> 


4.8.5 ”替换 节点 
使 用 replaceChild 方法 可 以 把 节点 中 已 有 的 一 个 子 节点 用 新 的 节点 替换 掉 。 语 法 如 下 。 


A.replaceChild newChild,oldchild 
其 中 ，A 是 一 个 节点 ，oldChild 是 A 节点 已 有 的 一 个 子 节点 ，newChild 是 其 他 节点 。 


epee mi nd nen sn 个 注释 节点 ， 然 后 用 新 建 的 
ContactInformation 元 素 节 点 替换 注释 节点 。 


Sub 替换 节点 () 
Dim DOC As MSXML2 .DOMDocument 
Dim Elem Rs MSXML2.IXMLDOMElement 
Dim ndl As MSXML2.IXMLDOMComment, nd2 Rs MSXML2.IXMLDOMElement 
Set DOC = New DOMDocument 
Set Elem = DOC.createElement ("Staff") ' 创建 一 个 元 素 节点 
Elem.setAttribute "name", "John" 
Set ndl = DOC.createComment ("This is a comment") 
Elem.appendChild ndl 
Set nd2 = DOC.createElement ("ContactIinformation") 
nd2.setAttribute "phone", "13612345678" 
nd2.setAttribute "address", "Beijing" 
Elem.replaceChild newChild:=nd2, oldChild:=ndl 
DOC .appendChild Elem 
Debug.Print DOC.XML 
DOC.Save ThisWorkbook.Path & "\temp.xml" 
End Sub 


上 述 过 程 运行 后 ， 浏 览 器 中 看 到 的 temp.xml 文件 结果 如 图 4-18 所 示 。 


- <Staff name="John"> 
<ContactInformation phone="13612345678" address="Beijing" /> 
</Staff> 


图 4-18 替换 节点 
4.8.6 ”克隆 节点 


CloneNode 方法 可 以 把 已 有 的 节点 复制 一 份 ， 复制 出 来 的 节点 可 以 插入 其 他 节点 中 。 克 
隆 节点 的 语法 如 下 。 

Set C = B.Clone (deep) 

其 中 , B 是 XML 中 任意 一 个 节点 , C 是 由 B 克隆 出 来 的 新 节点 ， 如 果 deep 参数 设置 
为 Tme， 表 示 深 层 克 隆 ， 也 就 是 B 节点 包含 的 深层 子 节点 一 同 克隆 ; deep 为 False 时 ， 只 克 
隆 B 节 点 的 外 壳 。 

“西南 省 份 xsml” 共 有 3 个 Province 元 素 节点 。 下 面 的 过 程 把 名 称 为 四 川 的 Province 元 
素 节 点 克隆 两 份 ， 一 份 采用 表层 克隆 ， 另 一 份 采 用 深层 克隆 。 最 后 把 克隆 出 来 的 两 个 节点 插 
人 Country 根 元 素 节 点 。 


Sub 克隆 节点 () 
Dim DOC Rs MSXML2.DOMDocument 
Dim Elem As MSXML2 .IXMLDOMElement 
Dim province As MSXML2 .IXMLDOMElement 
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Dim ndl Rs MSXML2.IXMLDOMElement, nd2 Rs MSXML2 .IXMLDOMElement 


Set DOC = New DOMDocument 

Doc.Load xmlSource:="E:\ 西南 省 份 .xml" 

Set province = DOC.SelectSingleNode ("/ 
Country/Province [ename=' 四 川 '] ") 

Set ndl = province.CloneNode (deep:=False) 

Set nd2 = province.CloneNode (deep:=True) 

province.ParentNode.appendChild ndl 

province.ParentNode.appendChild nd2 

Debug.Print DOC.XML 

DOC .Save ThisWorkbook.Path & "\temp.xml" 

End Sub 


运行 上 述 过 程 ， 产 生 的 新 文件 temp.xml 在 浏 
览 器 中 的 效果 如 图 4-19 所 示 。 

可 以 看 出 ndl 节点 只 是 原 节点 的 表层 ， 而 nd2 
和 原 节点 一 模 一 样 。 

以 上 内 容 的 源 代码 文件 为 “实例 文档 13.xlsm”。 


4.9 ”使 用 Schema 验证 XML 


通过 DOMDocument 对 象 的 Load 或 LoadXML 方法 可 以 装载 一 个 XML 文件 或 字符 串 ， 
如 果 XML 文件 符合 语法 基本 规则 ， 则 认为 是 形式 良好 的 ( Well-Formed)，Load 方法 相应 返 


回 True， 表 示 装 载 成 功 。 


但 是 在 很 多 情况 下 ,一 个 XML 文件 除了 具有 良好 的 形式 外 ， 还 需要 从 内 容 的 角度 去 判 


<?xml version="1.0" ?> 
<!-- 中 国 各 省 份 --> 
- <Country name=" 中 国 "> 
<!-- 以 下 列 出 西南 地 区 各 省 --> 
- <Province name=" 四 川 "> 
<Capital name 二 "成 都 " /> 
<Population Unit=" 万 人 ">8204</Population> 
</Province> 
- <province name=" 贵 州 "> 
<Capital name=" 贵 阳 " /> 
<Population Unit=" 万 人 ">3530</Population> 
</Province> 
- <Province name=" 云 南 "> 
<Capital name=" 昆 明 " /> 
<Population Unit=" 万 人 ">4742</Population> 
</Province> 
<Province name=" 四 咱 /> nd1 
- <Province name=" 四 川 "> nd2 
<Capital name=" 成 都 " /> 
<population Unit=" 万 人 ">8204</Population> 
</Province> 
</Country> 


图 4-19 ”克隆 节点 


断 是 否 满足 某 一 个 规则 或 格式 ， 如 果 不 满足 内 容 要 求 ， 相 应 地 给 出 原因 。 
对 现 有 XML 文件 进行 验证 操作 ， 需 要 了 解 和 准备 以 下 三 方面 内 容 。 


口 XSD 文件 : 用 于 建立 规则 或 格式 ， 该 文件 是 Schema 验证 能 否 通 过 的 核心 文件 。 可 
以 用 记事 本 程序 创建 或 使 用 专业 工具 ， 虽 然 扩 展 名 是 .xsd， 实 质 上 也 是 一 种 XML 


文件 。 


口 XMLSchemaCache 对 象 : 在 VBA 程序 中 声明 和 创建 ， 具 体 功 能 是 连接 XSD 文件 与 


XML 文件 。 


口 parseError 对 象 : 解析 错误 对 象 ， 返 回 解析 和 验证 的 结果 。 


4.9.1 在 XSD 文件 中 创建 规则 


创建 用 于 Schema 验证 的 XSD 文件 ， 体 系 相当 庞大 。 限 于 本 书 篇 幅 ， 此 处 仅 以 实例 演 


示 一 下 XSD 与 XML 文件 的 呼应 关系 。 


假设 每 个 员工 制作 体现 自己 信息 的 一 个 XML 文件 ， 具 体 要 求 如 下 。 
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口 根 元 素 节点 名 称 : Resume。 

口 根 元 素 下 面 必须 有 Name 、Gender、Birthday 、Phone 这 些 子 元 素 。 除 了 Phone 是 可 选 
元 素 外 ， 其 余 3 个 只 能 出 现 一 次 。 

口 Name 元 素 的 文本 内 容 是 2~3 个 字符 。 

口 Gender 只 能 选择 Male 或 Female。 

口 BirthDay 的 格式 必须 是 YYYY-MM-DD。 

口 Phone 的 格式 必须 是 11 位 连续 数字 。 

如 图 4-20 所 示 是 员工 李 四 制 作 的 XML 文件 “ 李 四 .xml”"， 可 以 看 出 该 文件 完全 符合 上 

述 要 求 。 


<?xml version="1.0" ?> 
- <Resume xmins="http://schemas.microsoft.comy/office/2009/07/customui"> 
<Name> 李 四 </Name> 
<Gender>Female</Gender> 
<Birthday>2010-11-12</Birthday> 
<Phone>13612345678</Phone> 
</Resume> 


图 4-20 “ 李 四 .xml” 文 件 内 容 


那么 ， 哪些 XML 不 符合 要 求 呢 ， 如 何 快速 判断 ”这 就 需要 创建 XSD 文件， 如 图 4-21 所 
示 是 笔者 用 记事 本 程序 创建 的 用 于 验证 上 述 XML 的 XSD 文件 ,文件 名 为 ResumeTemplate xsd。 


<?xml version="1.0" ?> 
- <xs:schema xmlns:xs="http:/ /www.w3.0rg/2001/XMLSchema" xmIns="http://schl 
targetNamespac ttp://schemas.microsoft.com/office/2009/07/customui" 
- <xs:element name="Resume"> 
- <xs:complexType> 
- <xs:sequence> 
- <xs:element name="Name" minOccurs="1"> 
- <xs:simpleType> 
- <xs:restriction base="xs:string"> 
<xs:minLength value="2" /> 
<xs:maxLength value="3" /> 
</xs:restriction> 
</xs:simpleType> 
</xs:element> 
- <xs:element name="Gender” minOccurs="1"> 
- <xs:simpleType> 
- <xs:restriction base=" 
<xs:enumeration valu 
<xs:enumeration value="Female” /> 
</xs:restriction> 
</xs:simpleType> 
</xs:element> 
- <xs:element name="Birthday" minOccurs="1"> 
- <xs:simpleType> 
- <xs:restriction base="xs:string"> 
<xs:pattern value="[0-9]{4}-[0-9]{2}-[0-9]{2}" /> 
</xs:restriction> 
</xs:simpleType> 
</xs:element> 
- <xs:element name="phone" minOccurs="0"> 
- <xs:simpleType> 
- <xs:restriction base="xs:integer"> 
<xs:totalDigits value="11" /> 
</xs:restriction> 
</xs:simpleType> 


图 4-21 XML 验证 文件 
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XSD 文件 看 起 来 错综复杂 ， 但 是 大 多 数 代码 都 是 一 成 不 变 的 。 这 里 重点 关注 
ComplexType 和 SimpleType。ComplexType 表示 是 复杂 元 素 ， 该 元 素 下 面 可 以 包含 子 节点 ， 
而 SimpleType 相反 ， 是 简单 节点 ， 不 能 包含 子 节点 。 

注意 图 4-21 中 粗 体 字 的 部 分 ， 可 以 看 出 ，Resume 元 素 是 一 个 ComplexType， 它 下 面包 
含 着 4 个 SimpleType。 每 一 个 SimpleType 包含 着 restriction (对 元 素 的 限制 条 件 )。 该 文件 
用 到 的 约束 技巧 如 下 。 

口 minOccurs: 最 少 出 现 次 数 ，0 表示 可 以 不 出 现 ，1 表示 必须 出 现 一 次 。 

口 minLength、maxLength: 最 短 字符 数 和 最 长 字符 数 。 

口 enumeration: 枚 举 值 。 

口 pattem: 用 正则 表达 式 约束 输入 格式 。 

口 totalDigits: 总 的 数字 位 数 。 


4.9.2 配置 DOMDocument 的 Schema 


准备 好 XSD 验证 文件 、XML 范例 文件 ， 就 可 以 在 VBA 中 进行 验证 了 。 验 证 的 具体 步 
又 如 下 。 

(1) 在 VBA 中 创建 一 个 XMLSchemaCache60 变量 schema。 

(2 ) 为 schema 指定 命名 空间 、XSD 文件 路 径 。 

(3 ) 创建 一 个 DOMDocument 变量 。 

(4) 用 DOMDocument 装载 XML 文件 ， 装 载 的 同时 进行 验证 。 

(5 ) 查看 ErrorCode 是 否 为 0， 如 果 不 为 0 则 调查 错误 原因 。 

假设 员工 张 三 创 建 的 一 个 XML 文件 “ 张 三 .xml” 如 图 4-22 所 示 。 


<?xml version="1.0" ?> 
- <Resume xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<Name>ZhangSan</Name> 
<Gender> 女 </Gender> 
<birthday>2010 年 11 月 12 日 </birthday> 
<Phone>136123456**</Phone> 
</Resume> 


图 4-22 “ 张 三 .xml” 文 件 内 容 
下 面 的 程序 用 于 验证 “ 张 三 .xml” 是 否 合法 。 


Sub SchemaValidate () 
Dim schema As MSXML2.XMLSchemaCache60 ' 声明 一 个 schema 验证 变量 
Set schema = New XMLSchemaCache60 ' 创建 一 个 schema 
schema.Add NamespaceURI:="http://schemas.microsoft.com/office/2009/07/customui", 
Var:=ThisWorkbook.Path & "\ResumeTemplate.xsd" 
' 为 schema 变量 添加 命名 空间 ， 并 且 指定 XSD 文件 的 所 在 路 径 
Dim DOC As New MSXML2 .DOMDocument60 
With DOC 
Set .Schemas = schema “ 把 schema 变量 与 DOM 文档 关联 
.async = False 
.validateOnparse = True " 解析 时 立即 验证 
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-resolveExternals = False 
-Load (ThisWorkbook.Path & "\ 张 三 .xml")' 装载 计划 验证 的 实例 XML 文件 
With .parseError ' 解析 错误 对 象 
IE .ErrorCode = 0 Then 
MsgBox " 通过 schema 验证 。"， vbInformation 
Else 
MsgBox " 错误 原因 : " & .reason & vbNewLine & " 引起 错误 的 节点 : " 
& .srcText, vbCritical 
End If 
End With 
End With 
End Sub 


代码 分 析 : schema 变量 、XSD 文件 、XML 文件 三 者 的 命名 空间 必须 是 一 致 的 ， 都 为 
http://schemas.microsoft.com/office/2009/07/customui， 如 果 不 一 致 ， 则 达 不 到 验证 的 效果 。 
运行 上 述 过 程 ， 弹 出 如 图 4-23 所 示 的 错误 对 话 框 。 
Microsoft Excel 2 


= -一 


错误 原因 : 'ZhangSan' 违反 了 '3' 的 maxLength 约束 。 
无 法 分 析 值 为 ZhangSan' 的 元 素 
{http://schemas.microsoft.com/office/2009/07/customui}Name’ 


| 引起 错误 的 节点 : ”<Name>ZhangSan</Name> 


图 4-23 使 用 XSD 文件 验证 XML 时 弹出 错误 
可 以 看 出 ， 错 误 原 因 是 Name 元 素 的 文本 太 长 。XSD 文件 要 求 2 ~ 3 个 字符 ， 实 际 是 8 
个 字符 。 
需要 注意 的 是 ， 如 果 XML 文档 存在 多 处 错误 ， 验 证 操作 进行 时 只 挑 出 第 一 个 错误 的 信 
息 ， 只 有 修复 了 第 一 个 错误 并 再 次 验证 ， 才 能 继续 弹出 后 续 的 错误 。 


4.9.3 “分析 验证 结果 


parseError 是 DOMDocument 对 象 的 一 个 成 员 ， 该 成 员 包含 如 表 4-4 所 示 的 属性 ， 用 来 
返回 错误 的 各 种 信息 。 


表 4-4 XML 验证 错误 对 象 的 成 员 


属 性 描 述 

errorCode 返回 一 个 长 整 型 错误 码 

Teason 返回 包含 错误 原因 的 字符 串 
line 返回 表示 错误 行 号 的 长 整 型 
linepos 返回 表示 错误 的 行 位 置 的 长 整 型 


srcText 返回 包含 引起 错误 的 行 的 字符 串 
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续 表 
属 性 描 述 
url 返回 指向 被 加 载 文档 的 URL 
filepos 返回 错误 的 一 个 长 整 型 文件 位 置 


其 中 ， 比 较 有 用 的 属性 有 errorCode 、reason 、strText、line 等 。 
以 上 内 容 的 源 代码 文件 为 “实例 文档 14.xlsm”。 


4.10 XML 与 Office 文档 


Office 文 档 (Excel 工 作 短 、Word 文 档 、_PowerPoint 演示 文稿 ) 对 象 都 有 一 个 
CustomXMLParts 的 集合 对 象 。 一 般 的 文档 默认 有 3 个 内 置 的 CustomXMLPart。 

通过 VBA 可 以 为 文档 添加 自 定义 XML， 也 可 以 从 文档 中 移 除 自 定 义 XML。 无论 是 添 
加 XML 还 是 移 除 XML ， 肉 眼看 不 出 来 ， 需 要 用 压缩 软件 打开 才能 看 到 变化 。 


4.10.1 添加 自 定义 XML 到 Word 文档 


下 面 的 实例 在 Excel VBA 中 编程 ， 向 处 于 打开 状态 的 Word 文档 中 添加 自 定义 XML。 
首先 为 Excel VBA 工程 添加 对 Word 的 外 部 引用 ， 如 图 4-24 所 示 。 


Microsoft Windows Installer Object a 
DMicrosoft Windows Media Player Net, 

OMicrosoft Windows Media Player Net, -一 
DMicrosoft WinHTTP Services，vwersio 浏览 人 8). . 


osoft. TeamFoundation. OfficeInt' = 
aenft VienslStndin PradnntKewh 
上 


Merosoft Word 15.0 Object Library 
定位 : C:\Program Files\Microsoft Office\OfficelS\MSHORD. 
语言 : 标准 


图 4-24 添加 外 部 引用 
然后 运行 下 面 的 过 程 ， 向 指定 Word 文档 添加 XML ， 并 且 保 存 文档 。 


Sub 添加 并 遍历 CustomXMLPart () 
Dim WordApp Rs Word.Application，doc Rs Word.Document ' 声明 Word 应 用 程序 、 文 档 


Dim p As office .CustomXMLPart " 声明 一 个 自 定 义 XML 部 分 
Dim i As Integer 
Set WordApp = GetObject(, "Word.Application") " 获取 Word 应 用 程序 


Set doc = WordApp.Documents(" 文档 中 的 自 定义 XML.docx") ' 获取 Word 文档 
Set p = doc.CustomxMLPparts.Add() ' 为 Word 文档 添加 一 个 自 定义 XML 
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p.Load (ThisWorkbook.Path & "\ 西南 省 份 .xml1") " 装载 文件 
Set p = doc.CustomxXMLParts.Add() 
p.Load (ThisWorkbook.Path & "\ 东北 地 区 .xml") 
For i = 4 To doc.CustomXMLParts.Count 
Debug.Print i, doc.CustomXMLParts.Item(i) .XML “" 打印 每 个 自 定义 XML 的 代码 


Next i 
doc.Save 
End Sub 


运行 上 述 过 程 后 ， 在 Word 中 关闭 “文档 中 的 自 定义 XML.docx” 文 件 ， 然 后 用 WinRAR 
打开 ， 如 图 4-25 所 示 。 


[EET WinAR GE meet 三 -二 
EEC OECD 


ESE 


“ 国 量 文人 中 的 十 XXMLdocAcustomXml - ZIP 压 斑 文件 解 包 大 小 为 56.963 闻 五 MM 
办 文档 中 的 自 定 义 XMLdocx| 名 称 


IEm 总 计 1 个 文件 夹 和 1140 字 (4 个 文人 


图 4-25 用 WinRAR 打开 Word 文档 


在 WinRAR 中 可 以 看 到 该 Word 文档 多 了 一 个 customXML 文件 夹 ， 其 中 有 iteml.xml 
和 item2.xml 两 个 文件 ， 这 两 个 就 是 利用 CustomXMLParts.Add 方法 添加 进来 的 。 


4.10.2” 读 取 Office 文档 中 的 自 定义 XML 


对 于 存储 于 Office 文 档 中 的 自 定义 XML， 还 可 以 用 同样 的 方法 读 取 出 来 ， 赋 给 
DOMDocument 对 象 。 

下 面 的 过 程 读 取 Word 文档 中 包含 的 两 个 自 定 义 XML。 首 先 手工 在 Word 中 打开 文档 
“文档 中 的 自 定义 XML.docx”"， 然 后 执行 Excel VBA 中 的 如 下 过 程 。 


Sub 读 取 CustomxMLPart () 
Dim WordApp As Word.Application，doc Rs Word.Document ' 声明 Word 应 用 程序 、 文 档 


Dim p Rs office .CustomXMLPart ' 声明 一 个 自 定义 XML 部 分 
Dim DOM As MSXML2 .DOMDocument 
Set WordApp = GetObject(, "Word.Application") "获取 Word 应 用 程序 


Set doc = WordApp.Documents (" 文档 中 的 自 定义 XML .docx") ' 获取 Word 文档 
For i = 4 To doc.CustomxMLParts.Count 

Set p = doc.CustomxXMLParts.Item(i) 

Set DOM = New DOMDocument 

DOM.LoadXML p.XML 

Debug.Print DOM.XML 
Next i 
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doc.Save 
End Sub 


运行 上 述 过 程 ， 立 即 窗口 成 功 打印 出 XML 代码 。 
4.10.3 ” 移 除 Office 文档 中 的 自 定义 XML 


下 面 的 过 程 移 除 Word 文档 中 的 自 定义 XML。 


Sub 移 除 CustomXMLPart () 
Dim WordApp Rs Word.Application，doc Rs Word.Document ' 声明 Word 应 用 程序 、 文 档 
Dim p Rs office .CustomXMLPart " 声明 一 个 自 定 义 XML 部 分 
Set WordApp = GetObject(, "Word.Application") "获取 Word 应 用 程序 
Set doc = WordApp.Documents(" 文档 中 的 自 定义 XML.docx") ' 获取 Word 文档 
For i = 4 To doc.CustomXMLParts .Count 
Set p = doc.CustomXMLParts .Item(4) 
p.Delete 
Next i 
doc.Save 
End Sub 


代码 分 析 : 为 了 不 移 除 内 置 的 XML，For 循环 从 4 向 后 遍历 ， 多 次 移 除 第 4 个 自 定义 
XML， 就 可 以 移 除 所 有 自 定 义 XML。 

运行 上 述 代 码 后 ， 再 用 WinRAR 打开“ 文档 中 的 自 定义 XML.docx”"， 就 看 不 到 
customXml 文件 夹 了 ， 如 图 4-26 所 示 。 


epeeMLdoo - WinRAR (FE ET = 
文件 (月 ”命令 (C) 工具 (S) “收藏 夫 (O) 远 项 (N) 帮助 (H) 
一 和 A 
EAS A 
添加 。 解压 到 和 下 看 开除 查找 向导 广 冬 。 自 有 
国 上 的 文 和 中 的 自 定 XXMLdocxword - ZIP 压 芝 文件 解 包 大 小 为 54.735 字 节 ~ 
办 文人 中 的 证 XXMLdocx | 名 称 e 大 小 压 坟 后 大 小 类 型 
Brels BB- 本 地 盘 
W docProps Brels 文件 突 
= Btheme 文件 夫 
Brets 名 domwmentxml 1.602 553 XML 文档 
ee @fontTablexml 1.546 523 XML 文档 
加 "omberingxml 3388 735 XML 文档 
图 setingsxml 6.798 2.054 XML 文 档 
加 sylesxml 29,375 3133 XML 文档 
长 webSettingsxml 497 265 XML 文档 
‘ D ra 到 
己 噬 总 计 2 文件 志和 43,206 字 二 (6 个 文件 ) 


图 4-26 移 除 Office 文档 中 的 XML 部 分 
需要 注意 的 是 ， 本 节 讲 述 的 自 定义 XML 与 后 面 讲 到 的 自 定义 功能 区 不 是 一 回 事 。 


4.10.4 工作 表 导 入 XML 


Excel VBA 的 Workbook 对 象 有 XmlMaps 和 XmlMap 对 象 ， 使 用 Workbook XmlImport 
方法 可 以 把 网 络 的 XML 文件 或 本 地 XML 文件 导入 工作 短 ， 成 为 一 个 XmlMap 对 象 。 
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Workbook 的 XmlImportXml 方法 与 XmlImport 方法 非常 类 似 ， 不 同 的 是 前 者 接受 的 参 
数 是 XML 代码 字符 串 ， 后 者 是 一 个 文件 路 径 。 

下 面 的 程序 向 工作 竹中 添加 一 个 XmlMap 对 象 ，XML 的 源 来 自 于 网 络 url， 并 且 把 导 人 
的 内 容 显 示 于 单元 格 Al。 


Sub 工作 表 导 入 XML 文件 () 
Dim Map As Excel.XmlMap 
Dim code As String 
ActiveWorkbook.XmlImport URL:="http://www.w3school.com.cn/example/xmle/ 
simple.xml", ImportMap:=Nothing, Overwrite:=True, Destination:=ActiveWorkbook. 
Worksheets (1) .Range ("A1") 
Application.DisplayXMLSourcePane 
Debug.Print ActiveWorkbook.XmlMaps.Count 
Set Map = ActiveWorkbook.XmlMaps.Item(1) 
Map.ExportXml Data:=code 
Map.Export URL:=ActiveWorkbook.Path & "\simple.xml", Overwrite:=True 
End Sub 


代码 分 析 : XmlMap 对 象 还 具有 Export 方 法 ， 可 以 把 存在 于 工作 簿 中 的 XmlMap 导出 
到 字符 串 变 量 或 者 文件 中 。 

运行 上 述 程 序 ， 当 前 工作 簿 中 导入 了 相应 的 XML 数据 ， 并 且 自 动 显 示 XML 源 窗 格 ， 
如 图 4-27 所 示 。 


印 日 9-0-。; 随机 姓名 .xsm - Excel 名 画 -二 一 口 -一 X. 
| = ii ra 全。 RE 讽 。 视 加 | 天 TIR | ja 项 mvoou -于 
Si 的 别 刁 站 --- ” 固 履 性 吕 时 属性 团 S 入 
沸 图 略 wlaxs 用 ”从 密 以 加 查看 人 到 扩展 外。 四 号 出 四 
Visual Basic 宏 jn 项 COM 加 坦 项 。 插入 设计 模式 Rn ， 一 玉 板 
全 产 安 全 性 - [EE 
代码 加 0 载 项 巷 件 XML 修改 人 
B20 > 天 
1 由 XML 源 SS 
2 Belgian Waffles 5.95 tyo of our fanous Belgian ¥affles with ple 650 
3 |stravberry Belgian Yaffles 7.95 light Belgian vaffles covered with stravbe ool “|| | ‘er 
4 Berry-Berry Belgian Waffles 8.95 light Belgian waffles covered with an ass¢ 900 breakfastmenu_ 呈 时 加 
5 French Toast 和 4 50 thick slices nade from our homemade sourde 600 ee 
6 Honestyle Breakfast $6.95 tvo eggs, bacon or sausage, toast, and ou 950 自信 food 
7 
8 四 priee ($5.95 ) 
9 a deseription ( two of 
10 calories ( 650 ) 
31 
12 
13 
14 
15 了 
地 [一 = » 
其 身 于 复元 素 ， 请 格 元 素 从 树 拖 动 到 
3 项 本数 据 标 二 出 现 的 工作 表 上 . 
19 | 去 要 导入 XML 数据 , 请 右键 单 主 一 个 
20 XML 器 时 的 单元 格 ， 然 后 指向 XML , 再 
pn 1 LL Ye 和 \". 
22 本 | 页 -| | XML 山 对 -. 
和 Seats 四 HL | ES 


图 4-27 工作 表 中 导入 XML 
以 上 内 容 的 源 代码 文件 为 “实例 文档 15.xlsm”。 
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4.11 本章 小 结 


XML 文件 中 ， 一切 皆 为 节点 ， 其 中 元 素 这 种 节点 构成 了 XML 文件 的 骨架 。 

XML 的 DOMDocument 文档 对 象 的 Load 方法 用 于 装载 一 个 XML 文件， 而 LoadXML 
用 于 装载 一 个 字符 串 。Save 方法 可 以 把 DOMDOcument 对 象 保存 为 XML 文件 。 

DOMDocument 文档 对 象 下 面 有 一 系列 以 Create 开头 的 方法 ， 用 于 创建 节点 。 但 是 创建 
了 的 节点 还 没有 加 入 文档 树 中 ， 需 要 用 AppendChild 方法 附加 进去 。 

节点 的 AppendChild 方法 可 以 使 另 一 个 节点 成 为 子 节点 。RemoveChild 方法 可 以 移 除 一 
个 子 节点 。 
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目 定 义 功能 区 


微软 Office 自 2007 版 开始 使 用 功能 区 代替 传统 的 菜单 栏 、 工 具 栏 ， 而 且 允 许 开 发 人 员 
对 Office 界面 进行 自 定义 。 

通过 学 习 本 章 知识 ， 可 以 在 Office 界面 加 入 自 定义 的 控件 ， 并 且 能 够 调用 VBA 中 的 过 
程 ， 从 而 制作 出 更 加 专业 的 插件 和 工具 。 


S.1 customUI 概述 


用 户 自 定义 界面 (Custom User Interface， 简 称 customUI)， 使 用 XML 语言 来 描述 。XML 代码 
中 通过 元 素 节点 的 包含 关系 来 表达 控件 的 包含 关系 ， 用 元 素 节 点 的 属性 来 表达 真正 控件 的 属性 。 

customUI 的 XML 代码 可 以 存储 于 Excel 工作 每 、Word 文档 、PowerPoint 演示 文稿 或 
Access 数据 库 中 。 但 是 对 于 没有 文档 的 组 件 ， 例 如 Outlook， 只 能 在 COM 外 接 程 序 中 使 用 
customUI 的 XML。 本 书 只 讨论 压缩 于 Office 文档 中 的 customUI 的 技术 。 

customUI 开发 过 程 包含 如 下 三 个 层面 。 

口 XML 代码 的 编写 和 存储 。 

口 Office 界面 呈现 。 

口 VBA 回调 的 生成 和 执行 。 

其 实 ， 可 以 用 一 句 话 来 概括 customUI 的 开发 过 程 : 

“修改 XML 代码 ， 使 得 Office 能 够 呈现 出 期 望 的 界面 ， 并 且 单 击 界面 中 的 自 定义 控件 ， 
能 够 调用 VBA 中 的 宏 。” 

可 以 看 出 , customUI 的 开发 过 程 ， 实 际 上 就 是 书写 和 优化 XML 代码 与 VBA 代码 的 过 程 。 

Office 界面 中 ， 可 以 自 定义 的 部 分 ， 也 就 是 允许 把 自 定 义 控件 加 入 的 场所 ， 主 要 有 以 下 
5 个 地 方 。 

口 常用 功能 区 (tabs)。 

口 快速 访问 工具 栏 (qat)。 
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口 环境 功能 区 (contextualTabs ) 。 
口 右键 菜单 (contextMenus ) 。 
口 Office 菜单 (backstage)。 


5.1.1 常用 功能 区 


常用 功能 区 是 指 Office 上 方 的 长 条 区 域 ， 由 多 个 选项 卡 组 成 ， 每 个 选项 卡 包含 多 个 组 ， 
每 个 组 可 以 有 多 个 控件 ， 如 图 5-1 所 示 。 


| 遇 = 属 < 王 - 
ET 开始 插页 加 布局 ”公式 数据 。 市 网 视图 开发 T 具 加 起 项 
ue -| 
Ey RA -| 裤 三 二 园 全 HE 中 - 
ie 元 5 对方 式 
G26 "| x w 万 
= 2 , 了 a 


图 5-1 Excel 常用 功能 区 


例如 ， 在 Excel 2013 的 常用 功能 区 中 ,“ 开 始 ” “插入 ”等 选项 卡 构成 了 一 个 tabs 集合 ， 
这 些 选 项 卡 是 切换 显示 的 ， 也 就 是 说 不 可 能 同时 看 到 多 个 选项 卡 。 
“开始 ”选项 卡 下 面包 含 “剪贴 板 ”“ 字 体 ”等 组 (group)， 每 个 组 中 包含 多 种 控件 。 


5.1.2 ”快速 访问 工具 栏 


快速 访问 工具 栏 (qat) 是 指 位 于 常用 功能 区 上 方 的 很 宕 的 区 域 ， 默 认 包 括 “ 保 存 ”“ 撤 
销 ”“ 重 做 ”等 基本 命令 。0O 人 tce 允许 用 户 在 快速 访问 工具 栏 中 添加 和 删除 命令 。 


5.1.3 “环境 功能 区 


环境 功能 区 ( contextualTabs)， 是 指 鼠 标 选中 某 类 型 对 象 ， 例 如 选中 了 一 个 图 片 ， 常 用 功 
能 区 的 右 侧 会 出 现 临时 的 选项 卡 。 当 鼠标 未 选中 任何 图 片 时 ， 该 选项 卡 消失 ， 如 图 5-2 所 示 。 
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图 5-2 特定 对 象 的 环境 功能 区 
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这 些 临 时 的 选项 卡 与 当前 所 选 对 象 类 型 有 关 。 靶 


插入 @ 
[要 
17 于 四 


| 
| 

5.1.4 “右键 菜单 | ee 
鼠标 选中 某 个 对 象 并 右 击 ， 会 弹出 相应 的 菜单 。 


回 SITf 雪 四) 
工作 雪村 和 戎 色 (D ， 
巷 洽 I 


(contextMenus)。 例 如 Excel 的 工作 表 标 签 的 右键 菜单 如 图 | eI 


Seer Smearz "Srey | | 


图 5-3 所 示 。 


图 5-3 工作 表 标 签 右 键 菜单 
5.1.5 ”Office 菜单 


Office 菜单 是 指 鼠 标 单 击 Office 左上 角 的 “文件 ”后 弹出 的 界面 ， 如 图 5-4 所 示 。 


I ~ Excel 
信息 
保护 工作 簿 属性 - 
» 控制 其 他 人 可 以 对 此 工作 矫 所 做 的 更 改 关 型 大 小 
保护 工作 短 es 
本 
村 
a 
国 检查 工 简 相关 日 期 
在 发 布 此 文件 之 前 ,请 注意 其 包 会 以 下 内 容 : 加 
检 音 问题 ”| 。 = 文档 性 、 作 者 的 姓名 和 池 对 路 径 起 
允 统 人 二 难 以 赔 该 的 内 容 便于 时 间 $ 天 20:36 
上 次 打印 时 间 
入 版 本 相关 人 员 
Q 六 找 不 到 此 文件 的 上 一 个 版 本 。 个 
ET | ryueifu 
添加 作者 
上 次 修改 者 尚未 保存 
嘱 浏览 器 视图 选项 旦 未 所 有 恨 性 
OY | 选 笃 在 Web 上 查看 此 工作 第 时 用 户 可 以 看 到 的 内 容 . 
sma 


图 5-4 Office 菜单 


5.1.6 ”手动 完成 customUI 设 计 


严格 地 讲 ，customUI 开发 设计 工作 ， 只 需 安装 Office 以 及 压缩 软件 就 够 了 。 下 面 讲解 
向 Office 文档 中 压 入 customUI 的 XML 代码 的 方法 。 

通过 第 4 章 的 内 容 可 以 了 解 到 ，Office 2007 以 上 版 本 的 Excel 工作 筹 、PowerPoint 演 
示 文 稿 、Word 文档 的 扩展 名 通常 是 4 个 字母 ， 这 些 文档 实际 上 都 是 压缩 包 ， 都 可 以 使 用 
WinRAR 等 软件 打开 、 查 看 和 编辑 。 

首先 新 建 一 个 空白 工作 敌 ， 保 存 为 “无 customUIxlsm”， 这 是 一 个 非常 普通 的 工作 短 ， 
在 Excel 中 打开 以 及 关闭 该 工作 短 ， 不 会 引起 任何 的 界面 变化 。 

工作 短 在 关闭 的 前 提 下 , 用 WinRAR 打开 该 工作 敌 ， 可 以 看 到 里 面包 含 3 个 文件 夹 和 1 
个 XML 文件， 如 图 5-5 所 示 。 
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x 0 | 


文件 (月 ”命令 (OQ ”工具 (S$) 收藏 夫 (O) 选项 (N) 帮助 (H) 


I 


本 看 丽 查找 
无 customULxlsm - ZIP 压 巡 文 件 , 解 包 大 小 为 15.970 字 节 - 


拓 无 customULxsm 
-rels 
且 docprops 
EE 


Bu 
加 [Content_Types]xml 1282 361 XML 文档 1980/1/1 0:0(| 


总 计 3 文件 夹 和 1.282 字 节 (1 个 文件 ) 


图 5-5 用 WinRAR 打开 Excel 文件 


其 中 ， 名 称 为 rels 的 子 文件 夹 中 包含 着 一 个 名 称 为 rels 的 XML 文件 ， 该 文件 的 内 容 
如 图 5-6 所 示 。 


FE 于 二 


文件 了。 岗 铀 (FE) 喜 看 (V) 帮助 (H) 


[ml version="1.0" encoding="UTF-8" standalone="yes"?| 
<Relationships xmns="http://schemas.openxmlformats. org/package/2006/relationships"><Relationship Id="rld3” 

[Type="http://schemas.openxmlformats.org/officeDocument/2006/relationshps/extended-properties" Target="docProps/app.xn"/> <Relationship 16="rid2" | 
[Type="http://schemas.openxmlformats.org/package/2006/relationshps/metadata/core-properties" Targat="docProps/core.xml"/><Relationship 1d="rid1" 
[rypa="http://schemas. opervmlformats.org/officaDocumant/2906/relationships/officaDocument" Targat="/workbook xml"/ > </Relatonships> | 


图 5-6 .rels 文件 的 内 容 


以 上 就 是 不 含 任何 customUI 的 文档 的 内 部 内 容 。 
接 下 来 ， 在 计算 机 的 任意 一 个 路 径 下 新 建 一 个 名 为 customUI 的 文件 夹 ， 在 该 文件 夹 中 
新 建 一 个 文本 文档 ,文档 内 容 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tabl" label="Microsoft" insertAfterMso="TabHome"> 
<group id="Groupl" label="Office"> 
<button id="ButtonID3" label="VBA" imageMso="V" size="large" 
onAction="Button Click"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


把 该 文本 文档 重 命名 为 customUI14.xml。 
最 后 ， 把 包含 customUI14.xml 的 文件 夹 customUI 拖 电 到 WinRAR 压缩 软件 窗口 中 ， 
也 就 是 把 该 文件 夹 添加 到 “无 customUIxlsm” 中 ， 如 图 5-7 所 示 。 
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图 5-7 把 customUI 文 件 夹 整体 压 入 Excel 文件 


接 下 来 ， 还 需要 改动 压缩 包 中 的 .rels 文件 ， 首 先 把 该 文件 释放 到 计算 机 的 任意 路 径 ， 
用 记事 本 程序 修改 为 如 图 5-8 所 示 的 样子 。 


EE SE = "= 


wine ope ojpechage/2005/relatonstips> <Relotonstip 到 -ord 
fschar 


pamaniformats.orgjofhoDocumen200S/relotiorehips/ eandied propertes” Target-:docPropeoppont /> <Relaboneh 
hamas.opareamliormate. oro/packege/2006 /raletian ches/metodrtaf core-proprtes” Torpet dcPropelonrs 
/workbock, 


图 5-8 修改 .rels 文件 内 容 
其 中 ， 反 选 的 那 行文 字 : 


<Relationship Id="Ra9dd55e5e85b4255"” Type="http://schemas .microsoft.com/ 
office/2007/relationships/ui/extensibility"”Target="customUI/customUI14.xml"/> 


就 是 告诉 Excel，customUI 使 用 的 文件 是 customUI14.xml。 

修改 后 的 文件 再 次 拖 放 回 压缩 包 进 行 同名 文件 替换 ， 此 时 就 可 以 关闭 压缩 工具 ， 在 
Excel 中 打开 该 工作 短 ， 可 以 看 到 在 “开始 ”选项 卡 右边 多 了 一 个 新 选项 卡 ， 单 击 “VBA” 
按钮 ， 弹 出 无 法 运行 宏 的 对 话 框 ， 如 图 5-9 所 示 。 


有 Eo 


V 


VBA 


图 5-9 customUI 找 不 到 对 应 的 回调 函数 
这 是 因为 前 面 的 XML 代码 中 有 一 句 : 


<button id="ButtonID3" label="VBA" imageMso="V" 


size="large" onAction="Button 
Click"/> 
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这 就 要 求 在 VBA 中 有 一 个 名 为 Button_Click 的 宏 ， 因 此 在 该 工作 德 的 VBA 工程 中 插 
入 一 个 标准 模块 ， 模 块 中 的 内 容 如 下 。 


Public Sub Button Click(control Rs Office.IRibbonControl) 
MsgBox ActiveCell.Address 
End Sub 


这 个 VBA 过 程 就 称 作 按 钮 的 回调 (callback)。 

回 到 Excel 再 次 单 击 “VBA ”按钮 ， 会 弹出 一 个 显示 单元 格 地 址 的 对 话 框 。 

以 上 手工 定制 的 方法 也 适用 于 PowerPoint 演示 文稿 和 Word 文档 。 

如 果 对 界面 不 满意 ， 还 可 以 继续 使 用 WinRAR 打开 文档 编辑 并 替换 customUI14.xml 
这 个 文件 ， 不 断 修改 完善 。 


注意 存储 于 文档 中 的 customUI 部 分 ， 只 有 该 文档 打开 ， 并且 处 于 活动 文档 时 ,才能 
看 到 自 定义 界面 ， 如 果 该 文档 失去 焦点 或 者 被 关闭 ， 自 定义 界面 随 之 消失 。 
5.2 ”使 用 customUI 软件 


通过 手工 进行 customUI 的 设计 ， 显 然 比较 烦琐 ,通常 借助 专业 软件 来 辅助 完成 。 常 用 
的 customUI 设计 软件 和 工具 如 表 5-1 所 示 。 


表 5-1 常用 的 customUl 软件 和 工具 


软件 名 称 
Custom UI Editor 
Office Ribbon Editor 
VS XML Editor 
Ribbon XML Editor 


5.2.1 命名 空间 和 Schema 验证 


对 于 customUI 中 的 XML 编写 ,微软 提供 了 Office 2007 和 Office 2010 以 上 版 本 的 命名 
空间 和 Schema 验证 文件 。 

口 Office 2007 兼容 。 

命名 空间 : <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> 

验证 文件 : customUIxsd 

口 Office 2010 以 上 版 本 兼容 。 

命名 空间 : <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 

验证 文件 : customUI14.xsd 

这 些 文件 的 作用 就 是 限制 XML 文件 中 哪些 元 素 可 以 出 现 ， 哪 些 属性 可 以 出 现 ， 以 及 属 
性 取 值 有 哪些 ， 如 果 使 用 了 不 符合 验证 文件 的 内 容 ， 验 证 就 不 会 成 功 。 
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因此 ,无论 你 用 的 是 哪 一 款 customUI 软件， 一 般 都 把 上 述 文件 作为 验证 标准 。 
5.2.2 Custom UI Editor 


该 软件 可 以 向 Office 文 档 中 压 和 人 XML， 支 持 自 定义 图 标 ， 总 体 性 能 良好 。 但 是 在 书写 
XML 代码 时 ， 没 有 自动 成 员 提 示 ， 如 图 5-10 所 示 。 


pr [<customOI tcom/offico/2009/07/customai"> 


<ribb: 


Presentaton02 ppt - Custom ULEditor for Microsoft OFF 


[</customUI> 


@ waoscera 


[| 


图 5-10 ”Custom UI Editor 软件 弹出 错误 提示 


5.2.3 Office Ribbon Editor 


该 软件 的 功能 更 加 丰富 ， 有 自动 成 员 提示 ， 如 图 5-11 所 示 。 
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图 5-11 Office Ribbon Editor 软件 有 自动 成 员 提示 


5.2.4 Visual Studio 中 的 XML Editor 


在 Visual Studio 中 , 单 击 菜单 【文件 /打开 文件 ] 浏览 到 任意 一 个 XML 文件 ， 就 可 以 
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进行 编辑 。 
只 要 该 XML 文件 的 命名 空间 是 Office customUI 的 命名 空间 ， 按 下 < 键 就 会 弹出 该 位 置 
允许 的 元 素 名 称 列表 ， 如 图 5-12 所 示 。 


BD Peweeniddin! -Microsoh Visval Sidon ER MEE cule P- ox 
XHN aD WEM A dE) Ftp) EMM Win Sou IRM WS asso SN BOW A 
9-9 可 -四 有 帆 DF- 人 -Pam- Debu -| 两 -生日 打针 蒜 | 全 四 包 和 如 全 | 名 和 目 站 用 生 < 


ee- 安信 旦 ”这 过- 天 各 -和 -7 二 0- 


图 5-12 ”Visual Studio 的 XML 编辑 器 


在 书写 XML 时 ， 可 以 明确 地 知道 元 素 下 面 允 许 使 用 哪些 子 元 素 ， 元 素 可 以 包含 哪些 属 
性 ， 属 性 可 以 取 哪 些 值 。 


5.2.5 Ribbon XML Editor 


该 软件 是 笔者 开发 的 一 款 功 能 强大 的 customUI 工具 ， 如 图 5-13 所 示 。 
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图 $-13 Ribbon XML Editor 软件 界面 
除了 具有 其 他 软件 的 通用 功能 外 ， 本 工具 还 具有 以 下 几 个 独特 功能 。 
口 实时 查看 功能 : 无 须 保存 到 Office 文档 ， 就 可 以 立即 看 到 Office 界面 的 变化 。 
口 面向 VBA、VB6、VSTO 开发 的 多 种 回调 函数 。 
口 自动 补 全 、 自 动 缩 进 功能 。 
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以 从 本 书 配套 资源 下 载 RibbonXMLEditor2018.01.06-Setup.exe。 

本 章 以 下 内 容 均 采用 Ribbon XML Editor 软件 进行 customUI 设计 。 因 此 首先 介绍 一 下 
该 软件 的 基本 用 法 。 

1. 向 Office 文档 压 入 XML 

启动 Ribbon XML Editor 软件 ， 切 换 到 “ Office2010 兼容 "， 输 入 如 图 5-14 所 示 的 XML 
代码 。 


ee 
[esomblanlosrhtpschemasmicrosofreomofiee00907ieuxomi 
onerEroaSoniair iier 


<uabid- a label ieroeol ho Tubtioae 
ee label="Office” 
"BuonlD3" label="VBA" inageMso-"V" size="large” onAction="Buton_ Click"/> 


图 5-14 编辑 XML 代码 
单 击 工 具 栏 中 的 “验证 ”按钮 ， 如 果 验 证 成 功 ， 单 击 “ 保 存 ” 按 钮 ， 选 择 计算 机 中 已 
有 的 一 个 Office 文档 ， 例 如 “实例 文档 31.xlsm”。 提 示 压 和 成功 ， 在 Excel 中 再 次 打开 该 文 
档 ， 在 “公式 ”选项 卡 右 侧 出 现 一 个 新 的 自 定义 选项 卡 ， 如 图 5-15 所 示 。 


5 Go- St xlsm - Excel 
于 EA 局。 公 | Micrcsof | 到 大 。 南 同 。 视 加。 开发 T 具 。 图 队 


[x v £ 
B C D E y 6 H I 十 
图 5-15 打开 带 有 customUI 的 Excel 文件 


接 下 来 为 button 设计 回调 函数 ， 回 到 Ribbon XML Editor， 在 代码 区 右 击 ， 在 弹出 菜 
单 中 选择 【 查看 回调 /VBA ]， 此 时 自动 得 到 回调 函数 ， 如 图 5-16 所 示 。 
TT | 


aml gamlenl nly waa el Tea 
Office2001 兼 容 | 03fic: ee 后 请 效 桔 
中 ， 村 


| 请 淮 柑 坎 ! 度 
Palle Suh Ptton Clack (control hs office Ratboncon tol) 


> | 


图 5-16 自动 得 到 回调 函数 
把 上 述 过 程 粘 贴 到 工作 短 的 标准 模块 中 ， 并 增加 过 程 中 的 代码 ， 如 下 所 示 。 


Public Sub Button Click(control As Office.IRibbonControl) 
MsgBox ActiveCell.Address 
End Sub 
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此 时 ， 单 击 功能 区 中 的 自 定义 按钮 ， 会 弹出 活动 单元 格 地 址 。 

可 以 看 出 ， 一 个 完整 的 customUI 设计 的 流程 包括 以 下 5 个 必 不 可 少 的 步骤 。 
(1 ) 编写 XML 代码 。 

(2 ) 验证 XML 代码 。 

(3 ) 查看 回调 函数 。 

(4) 把 XML 压 入 Office 文档 。 

(5 ) 打开 Office 文档 查看 界面 ， 并 写 和 人 回调 函数 ， 保 存 文件 。 


2 查看 现 有 文档 中 的 customUI 部 分 

Ribbon XML Editor 也 可 以 从 现 有 文档 中 抽出 XML 代码 ， 单 击 工具 栏 的 “打开 ”按钮 ， 
选中 一 个 Office 文档 ， 就 可 以 取出 该 文档 中 包含 的 XML 代码 。 

如 果 单 击 工具 栏 中 的 “ 移 除 ”按钮 ， 则 可 以 把 包含 customUI 的 Office 文 档 中 的 XML 
全 部 移 除 。 

3. 实时 查看 效果 

Ribbon XML Editor 软件 可 以 在 编写 XML 的 同时 ， 直 接 在 相应 的 Office 组 件 中 查看 效 
果 。 例 如 ， 单 击 菜单 【查看 /PowerPoint ]， 或 者 按 下 快捷 键 【 Ctrl+F4 ]， 如 图 5-17 所 示 。 


hon dor or offen 8 


icrosoft.com/office/2009/07/customui"> 
Else 


abl" label="Microsoft" insertAfterMso="TabFornmlas"> 
zeroup id-"Group1" label="Office"™> 

<button id="ButtonID3" label="VBA" imageMso="V" 司 
> 


</aroup 


图 5-17 在 相应 组 件 中 查看 customUI 效 果 
此 时 ， 会 自动 启动 PowerPoint， 并 可 以 看 到 在 PowerPoint 中 多 了 自 定义 的 界面 ， 如 图 5-18 所 示 。 


出 日 So 而 RF - powerpairt ? 国 = 这: 
| sa 阿 
we 
om 


单 击 此 处 添加 标题 


单 击 此 处 知 加 避 标 是 


EE 三 = 起 EE 区 叶 


图 5-18 ”PowerPoint 中 查看 customUI 效果 


es 
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这 样 ， 无 须 向 Office 文档 中 保存 XML， 就 可 以 快速 看 到 customUI 引 起 的 界面 变化 。 
5.2.6 ”显示 加 载 项 用 户 界 面 错误 


编写 XML 时 ， 经 常 遇见 各 种 各 样 的 错误 ， 例 如 idMso 控件 名 称 不 存在 、 未 在 VBA 中 
建立 相应 的 回调 函数 等 ， 如 果 把 不 合适 的 XML 压 入 Office 文档 ， 打 开 该 文档 应 该 会 弹出 相 
应 的 错误 。 

因此 ， 需 要 在 Excel 的 选项 对 话 框 中 切换 到 “高 级 ”选项 卡 ， 勾 选 “ 显 示 加 载 项 用 户 界 
面 错误 ”， 如 图 5-19 所 示 。 
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图 5-19 设置 “显示 加 载 项 用 户 界面 错误 ” 
如 果 不 勾 选 ， 即 使 XML 存在 严重 错误 ,文档 打开 后 ， 也 不 会 有 任何 提示 。 因 此 ,为 了 
顺利 进行 customUI 开发 ， 一 定 要 勾 选 该 复 选 框 。 
例如 ， 在 Excel 中 应 用 如 下 customUI。 


ED 攻 二 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tabl" label="Microsoft" insertAfterMso="TabFormula"> 
<group id="Groupl" label="Office"> 
<button id="ButtonID3" label="VBA" imageMso="V" size="large" 
onAction="Button Click"/> 


SO RibbonTest for Excel 14.0 中 的 自 定 义 U1 运行 时 湛 误 [>] 
</tab> 
</tabs> 在 RibbonTest for Excel 14.0" 的 自 定义 UL XML 中 发 现 模 误 : 
</ribbon> @ 2 
</customUI> “1 
未 和 Office 控件 ID: TabFormula 
此 时 会 立即 弹出 “未 知 Offce 控 件 ID : | 


TabFormula ”错误 ， 如 图 5-20 所 示 。 图 5-20 customUI 引 起 的 错误 
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引起 上 述 错误 的 原因 是 ，Excel 的 “公式 ”选项 卡 的 iaMso 是 TabFonmulas。 


5.3 ” 自 定 义 常用 功能 区 


常用 功能 区 是 指 Office 软件 上 面 的 条 形 区 域 ， 通 常 位 于 快速 访问 工具 栏 下 方 ， 如 图 5-21 
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图 5-21 常用 功能 区 


对 于 Excel 2013 ， 在 常用 功能 区 中 由 “开始 ” “插入 ”等 选项 卡 构成 了 一 个 tabs 集合 。 
对 于 某 一 特定 选项 卡 ， 例 如 ，“ 开 始 ”选项 卡 由 “剪贴 板 ” “字体 "“ 对 - <customur> 


- <ribbon> 


齐 方式 ”等 组 (group) 构成 。 组 与 组 之 间 通 过 一 条 竖 线 分 隔 。 bs> 
组 是 由 各 种 各 样 的 控件 (control) 构成 的 。 os 
</group> 
因此 ， 用 于 自 定义 常用 功能 区 的 XML 层级 结构 如 图 5-22 所 示 。 Wats 


</tabs> 


用 于 自 定义 常用 功能 区 的 XML 只 能 有 一 个 customUI、ribbon、 et 
tabs 元 素 节点 。 但 是 tabs 下 面 可 以 有 多 个 tab (选项 卡 ) 一 个 tab 下 国 52 向 定义 常用 
面 可 以 有 多 个 group (组 )， 一 站 group 下 面 可 以 有 多 个 控件 元 素 。 功能 区 的 XML 结构 


5.3.1 选项 卡 


对 选项 卡 (tab) 的 定制 ， 既 可 以 在 内 置 选项 卡 后 面 创建 全 新 的 用 户 选项 卡 ， 也 可 以 对 
Office 内 置 选项 卡 进行 修改 。 

启动 Ribbon XML Editor， 切 换 到 选项 卡 【 Office 2010 兼容 ]， 单 击 工具 栏 【 模 板 /功能 
区 ])， 自 动 生成 常用 功能 区 的 模板 ， 如 图 5-23 所 示 。 
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5-23 ”使 用 模板 
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然后 在 模板 代码 中 间 空 白 处 插入 相关 代码 ， 效 果 如 下 : 


<customUI xmlns="http://schemas .microsoft .com/office/2009/07V/customui"> 
<ribbon startFromScTratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
</tab> 
<tab idMso="TabHome" label="Start"> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


单 击 【 验 证 ] 按钮 ， 通 过 验证 后 ， 单 击 菜单 【查看 /Excel 】, 会 看 到 Excel 多 了 一 个 “ 扩 
展 功 能 ”的 新 选项 卡 ， 而 且 内 置 选 项 卡 “开始 ”被 重 命名 为 “Start”， 如 图 5-24 所 示 。 


[SEE Ir -Excel 


EC A 


de 宗 休 LY S 
pr 

Wm | Tu-|B-|S-A- - %， 祖 剖 
5 字体 5 2 5 Ea 5 

D6 "x v 大 


图 5-24 ”修改 内 置 选 项 卡 的 标题 


XML 代码 分 析 : 

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 这 名 声明 了 命 
名 空间 ， 一 般 Office 2010 及 其 以 上 版 本 都 是 这 个 命名 空间 。Office 2007 要 换 成 <customUI 
xmlns="http://schemas.microsoft.com/office/2006/01/customui">, 

startFromScratch="false" 表示 不 擦 除 内 置 选项 卡 ， 如 果 改 为 startFromScratch="true"， 则 
表示 隐藏 内 置 选项 卡 ，Excel 会 变 成 如 图 5-25 所 示 的 样子 。 


工作 秒 2 - Excel 
扩展 功能 


D6 “| x v £ 
& B E D E 下 9 H 和 全 


图 5-25 ”隐藏 内 置 选 项 卡 
<tab id="Tab2018" label=" 扩展 功能 "> 表示 创建 一 个 新 选项 卡 ， 指 定 了 id 和 label。 
对 于 用 户 创建 的 自 定 义 tab 、group 和 各 种 控件 ， 必 须 指 定 id， 而 且 互 不 重复 ， 也 就 是 
不 能 有 两 个 元 素 的 id 一 样 。 
对 于 引用 Office 内 置 tab 、group 和 控件 ， 不 能 使 用 id， 而 是 使 用 idMso。 例 如 : 


<tab idMso="TabHome" label="Start"> 


表示 把 内 置 选项 卡 “开始 ”的 标题 修改 为 “Start”。 
具体 Office 2013 有 哪些 内 置 idMso， 请 参考 5.4.1 节 。 
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5:3.2 组 


组 ( group) 是 tab 的 子 元 素 节 点 ， 同 时 group 也 是 各 种 控件 的 父 节点 。 用 户 自 定义 组 既 
可 以 放 在 自 定 义 选项 卡 中 , 也 可 以 放 在 Office 内 置 选项 卡 中 。 

group 的 主要 属性 与 tab 相似 ， 主 要 包括 id 和 label 这 些 常 规 属性 。 

下 面 的 XML 代码 在 “扩展 功能 ”选项 卡 中 添加 一 个 “信息 反馈 ”组 ， 然 后 放 人 一 个 
Excel 2013 内 置 的 “字体 ”组 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="Tab2018" label=" 扩展 功能 "> 
<group id="Group2019"” label=" 信息 反馈 "> 
</group> 
<group idMso="GroupFont"> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


在 Ribbon XML Editor 中 ， 单 击 【 查看 /Excel ]， 可 以 看 到 在 “开始 ”选项 卡 的 “字体 ” 
组 左 侧 多 了 一 个 自 定义 组 ， 如 图 5-26 所 示 。 


本 日 9- ce， fs 和 1 - Excel 
8 逢 入 局 公式 数 呈 。 训 央视 图 开 8T 贞 。 加 上 天 。 团队 | 扩 砚 和 


Er eR 
gryu:| 驴 -A 奖 : 
| 信 息 反 馈 | 字体 


D E 


图 5-26 插入 自 定义 组 


需要 注意 的 是 ，XML 中 先 写 的 元 素 先 出 现 ， 后 写 的 元 素 后 出 现 。 由 于 代码 中 自 定 义 组 
在 前 ， 因 此 自 定义 组 排 在 左 侧 。 

下 面 将 要 讲述 group 中 可 以 放置 的 各 类 控件 ( controls)。 控 件 还 可 以 划分 为 基本 控件 
( simple control) 和 容器 控件 ( content control)， 像 按钮 、 文 本 框 控件 等 这 类 不 可 以 再 包含 其 
他 控件 的 ， 就 属于 基本 控件 或 简单 控件 ;而 像 菜单 、 分 型 菜 单 、 按 钮 组 等 通常 是 其 他 控件 的 
容器 ， 因 此 属于 容器 控件 或 复杂 控件 。 


5.3.3 按钮 


按钮 (button) 是 命令 按钮 控件 ， 可 以 放 在 自 定义 的 group 或 者 内 置 组 中 。button 的 基本 
属性 也 是 id (或 14Mso)、label。 

下 面 的 XML 中 , 在 group 元 素 之 下 定义 了 2 个 button， 规 定 了 每 个 button 的 id 和 标题 
文字 。 


人 厂 office VBA 开 发 经 典 一 中 级 进 阶 郑 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 


<ribbon startFromScratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019"” label=" 信息 反馈 "> 


<button id="Buttonl” label=" 自动 转换 "/> 
<button id="Button2"” label=" 手工 转换 "/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 
与 上 面 XML 代码 对 应 的 Excel 界 面 如 图 5-27 所 示 。 
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图 5-27 添加 自 定义 按钮 控件 


可 以 看 出 ， 新 的 选项 卡 排 在 已 有 选项 卡 的 右 侧 ,组 也 是 这 样 的 。 但 是 像 button 这 样 的 
控件 ， 每 列 能 放置 3 个 控件 ， 因 此 按照 从 上 到 下 先 排列 ， 排 满 一 列 后 向 右 排列 。 
需要 注意 的 是 ， 图 中 “扩展 功能 ”是 选项 卡 的 标题 文字 ,“ 信 息 反 馈 ” 是 组 的 标题 文字 ， 


“自动 转换 ”是 按钮 的 标题 文字 。 


5.3.4 ”小 结 回顾 


以 上 讲述 了 自 定义 常用 功能 区 的 基本 XML 架构 和 语法 。 为 了 便于 后 续 内 容 的 理解 消 


化 ， 下 面 列 出 自 定义 功能 区 技术 的 几 个 要 点 和 特征 。 


1 严格 的 层次 递 进 关系 
常用 功能 区 的 XML 结构 如 图 5-28 所 示 。 


一 定 要 记 住 这 个 递 进 层次 : <customUI><ribbon><tabs><tab><group><controls/>。 


其 中 ，controls 表示 各 种 控件 。 


2， 自 定义 元 素 与 Office 内 置 元 素 混杂 

对 于 用 户 新 增 的 元 素 ， 例 如 新 的 tab、group 、button， 必 须 
规定 唯一 识别 的 记 属 性 ， 如 果 被 操作 或 引用 的 是 内 置 元 素 , 使 用 
idMso 属性 。 


3 容器 元 素 必须 用 两 个 标签 ， 简 单元 素 用 一 个 标签 
例如 group 是 一 个 容器 ,那么 开始 标签 是 <group 若干 属性 >， 
然后 接着 放 入 其 他 控件 ， 最 后 用 </group> 来 闭合 。 


- <customUI> 
- <ribbon> 
- <tabs> 
- <tab> 
- <group> 
<controls /> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


图 5-28 常用 功能 区 的 
XML 结构 
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而 简单 元 素 则 用 单行 形式 形成 一 个 完整 的 XML 节点 。 例 如 : 
<button id="Button2"” label=" 手工 转换 "/> 


要 留意 最 后 面 尖 括 号 左 侧 的 斜 杠 。 
下 面 继续 讲解 各 类 型 控件 的 添加 方法 。 


5.3.5” 复 选 框 


复 选 框 ( checkBox) 通常 由 勾 选 方 块 和 标题 文字 构成 ， 可 以 对 用 户 的 勾 选 和 取消 勾 选 行为 
做 出 反馈 。 下 面 的 XML 在 group 中 放 入 一 个 自 定义 checkBox 控件 和 一 个 内 置 复 选 框 控件 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tab2018" label=" 扩展 功能 "> 
<group id="Group2019"” label=" 复 选 框 展示 组 "> 
<checkBox id="checkl"” label=" 自动 转换 "/> 
<checkBox idMso="ViewHeadings"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


与 上 面 XML 代码 对 应 的 Excel 界面 如 图 5-29 所 示 。 
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图 5-29 添加 自 定义 复 选 框 


注意 上 面 的 XML 代码 不 能 用 于 Excel 以 外 的 Office 组 件 ， 因 为 dMso="ViewHeadings" 
这 个 内 置 控件 是 Excel 独 有 的 。 


5.3.6 ”组 合 框 


组 合 框 (comboBox) 是 一 种 容器 控件 ， 其 中 的 条 目 由 item 元 素来 规定 。 下 面 的 XML 
在 group 中 加 入 了 一 个 内 置 的 字体 组 合 框 ， 并 且 创 建 了 一 个 用 户 自 定义 组 合 框 。 自 定义 组 合 
框 中 的 内 容 是 12 个 月 份 的 英文 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="false"> 
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<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019" label=" 组 合 框 展示 组 "> 


<comboBox idMso="Font"/> 
<comboBox id="Combol"” label=" 月 份 "> 
<item id="Monthl" label="January"/> 


<item 
<item 


id="Month2" 
id="Month3" 


label="February"/> 
label="March"/> 


<item id="Month4" April"/> 
<item id="Month5" May" /> 
<item id="Month6" June"/> 


<item 
<item 
<item 


id="Month7" 
id="Month8" 
id="Month9" 


July"/> 
label="August"/> 
label="September"/> 


<item id="Month10" label="October"/> 
<item id: onth11"” label="November"/> 
<item id="Month1l2" label="December"/> 
</comboBox> 
</group> 
</tab> 
</tabs> 
</ribbon> 


</customUI> 


与 上 述 XML 代码 对 应 的 Excel 界面 如 图 5-30 所 示 。 
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图 5-30 添加 自 定 义 组 合 框 


组 合 框 的 取 值 ， 既 可 以 来 自 于 任意 一 个 item 的 label， 同 时 也 可 以 像 文 本 框 一 样 接受 用 
户 输入 ， 如 图 5-30 所 示 ， 可 以 用 键盘 输入 “腊月 ”两 个 字 。 


5.3.7 下 拉 框 


下 拉 框 (dropDown) 与 组 合 框 的 主要 区 别 是 ， 下 拉 框 不 接受 用 户 键盘 输入 ， 只 能 从 下 拉 
条 目 中 选择 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
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<group id="Group2019" label=" 下 拉 框 展示 组 "> 
<dropDown id="Dropl” label=" 月 份 "> 
<item id="Monthl" label="January"/> 
<item id="Month2" label="February"/> 
<item id="Month3" label="March"/> 


</dropDown> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 
与 上 述 XML 对 应 的 Excel 界面 如 图 5-31 所 示 。 
围 日 95.6.; 
| = i 
月 份 目 
January 
February 
2 March 
|D2 “|x v £ 


图 5-31 添加 自 定义 下 拉 框 


5.3.8 ”文本 框 


文本 框 (editBox) 是 应 用 非常 广泛 的 一 类 控件 ， 可 以 让 用 户 输入 一 些 文本 、 数 字 等 内 
容 ， 如 果 要 显示 文本 框 左 侧 的 说 明 性 文字 ， 需 要 设置 showLabel 属性 为 true ; 设置 为 false 
则 隐藏 标签 文字 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019"” label=" 文本 框 展 示 组 "> 
<editBox id="EditBoxl" showLabel="true"” label=" 姓名:"/> 
<editBox id="EditBox2" showLabel="true"” label=" 年 龄 :"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-32 所 示 。 


国 日 59- e-s 
| 
姓名: 


富 
年 龄 : 36 


[pz "四 x v 大 


图 5-32 添加 自 定义 文本 框 
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5.3.9 标签 


标签 (labelControl) 控件 用 于 显示 一 些 说 明文 字 ， 规 定 其 label 属性 即 可 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScTratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019"” label=" 标签 展示 组 "> 
<labelControl id="Labell” label=" 更 多 选项 "/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-33 所 示 。 


[2 

| = 人 生 3 讽 袖 加 和 TI | 扩展 9 能 
更 多 选项 

标 等 展示 组 

E3 了 全 二 ~ 大 


图 5-33 添加 自 定义 标签 


5.3.10 ”分隔 线 


分 隔 线 ( separator) 用 于 隔离 相 邻 的 控件 ， 正 常 的 控件 一 般 是 上 下 方向 可 以 放置 3 个 控 
件 ， 但 是 插入 separator 后 ， 后 续 的 控件 出 现在 下 一 列 。 
下 面 的 XML 首先 放 和 一 个 标签 控件 ， 然 后 加 入 分 隔 线 ， 再 放 和 人 另外 一 个 标签 控件 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromSscratch="false"> 
<tabs> 
<tab id="Tab2018"” label=-" 扩展 功能 "> 
<group id="Group2019"” label=" 分 隔 线 展示 组 "> 
<labelControl id="Labell"” label=" 更 多 选项 "/> 
<separator id="Separatorl"/> 
<labelControl id="Label2"” label=" 功能 定制 "/> 
</group> 
</tab> 
</tabs> 
</ribbon> 


</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-34 所 示 。 
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围 日 操 e- =- 
| = i 
更 多 选项 功能 定制 


分 隔 线 展示 组 
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图 5-34 ”添加 分 隔 线 


5.3.11 ”切换 按钮 


切换 按钮 (toggleButton) 有 按 下 和 弹 起 两 种 状态 ， 例 如 字体 的 加 粗 、 倾 斜 都 是 这 类 控 
件 。 下 面 的 XML 向 group 中 添加 一 个 自 定义 切换 按钮 ， 然 后 添加 一 个 内 置 的 加 粗 切 换 按 钮 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="Tab2018" label=" 扩展 功能 "> 
<group id="Group2019" label=" 切换 按钮 "> 
<toggleButton id="Togglel"” label=" 斜体 "/> 
<toggleButton idMso="Bold"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-35 所 示 。 


5 
开始 ”插入 页 面 布局 。 公式 证 网 ”视图 开发 I 具 扩展 功能 


图 5-35 添加 自 定义 切换 按钮 


5.3.12 ”控件 箱 


控件 箱 (box) 是 一 个 容器 控件 ， 该 容器 可 以 把 多 个 控件 捆绑 为 一 体 。box 的 boxStyle 属 
性 有 horizontal 和 vertical 两 种 取 值 。 
下 面 的 XML 分 别 用 水 平 捆绑 、 垂 直 捆绑 Buttonl 和 Checkl 控件 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019" label=" 水 平 捆绑 "> 
<box id="Boxl" boxstyle="horizontal"> 
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<button id="Buttonl" label="Buttonl"/> 
<checkBox id="Checkl" label="Checkl"/> 
</box> 
<editBox id="Editl" label="Name:"/> 
</group> 
<group id="Group2020"” label=" 垂直 捆绑 "> 
<box id="Box2" boxSstyle="vertical"> 
<button id="Button2" label="Buttonl"/> 
<checkBox id="Check2" label="Checkl"/> 
</box> 
<editBox id="Edit2" label="Name:"/> 
</group> 
<group id="Group2021" label=" 一 般 显 示 "> 
<button id="Button3" label="Button1l"/> 
<checkBox id="Check3" label="Check1"/> 
<editBox id="Edit3" label="Name:"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-36 所 示 。 


国 日 5- 6-: 
于 开发 I 具 | 扩展 功能 
Button1 [DCheck1 Button1 Name: Button1 
Name: Check1 Check1 
Name: 
水 平 扫 绑 委 直 扫 绑 一 般 显示 
|c7 -|i|x v E£ 
> B 站 D E 下 6 H 


图 5-36 ”使 用 控件 箱 


可 以 看 出 box 本 身 没 有 任何 外 观 显 示 , 在 “水 平 捆绑 ”组 中 ，Buttonl 和 Checkl 进行 
水 平 捆绑 ， 因 此 这 两 个 控件 显示 在 同一 行 ， 其 余 控 件 另 起 一 行 。 

在 “垂直 捆绑 ”组 中 ， 被 捆绑 的 控件 单独 占据 一 列 ， 其 余 控 件 必须 另 起 一 列 。 

在 不 使 用 box 的“ 一般 显示 ”组 中 ，3 个 控件 上 下 排列 在 同一 列 。 


5.3.13 ”控件 组 


控件 组 (buttonGroup) 的 功能 与 box 非常 相似 ,但 与 box 有 好 几 处 不 同 ， 如 下 所 示 。 

口 只 能 平 捆绑 。 

口 可 以 包含 的 子 控件 类 型 有 限 。 

下 面 的 XML 首先 向 group 中 添加 一 个 buttonGroup 控件 ， 其 次 往 该 控件 组 中 添加 3 个 
子 控件 。 最 后 向 group 中 添加 一 个 文本 框 。 


<customUI xmlns="http://schemas.microsoft .com/office/2009/07/customui"> 
<ribbon startFromSscratch="false"> 
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<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019" label=" 水 平 捆绑 "> 
<buttonGroup id="ButtonGroupl"> 
<button id="Buttonl" label="Buttonl"/> 
<toggleButton id="Togglel" label="Togglel"/> 
<control idMso="FormatPainter"/> 


</buttonGroup> 
<editBox id="Editl" label="Name:"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 


</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-37 所 示 。 


日 与- ee = 
| 
Button1 Toggle1 学 格 二 恒 


Name: | 


水 平 捆绑 


L13 了 国 四 x ~ ££ 
图 5-37 使 用 控件 组 


由 于 按钮 、 切 换 按钮 、 格 式 刷 三 个 控件 被 水 平 放 入 控件 组 中 ， 因 此 不 能 换行 ， 只 能 保持 
在 同一 行 。 


5.3.14 图片 库 


图 片 库 (gallery) 是 一 种 容器 控件 ， 下 面 可 以 容纳 item 元 素 。 gallery 本 身 也 是 一 种 控件 ， 
可 以 设置 其 image、label 属性 。 更 重要 的 是 要 设置 其 子 元 素 的 行 数 和 列 数 。 
下 面 的 XML 代码 在 gallery 中 呈现 3 行 2 列 的 item。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="Tab2018" label=" 扩展 功能 "> 
<group id="Group2019"” label="3 行 2 列 "> 
<gallery id="Galleryl”label=" 我 的 图 库 " imageMso="G" rows="3" 
columns="2"> 
<item id="picl" label="picl" imageMso="A"/> 
<item id="pic2" label="pic2" imageMso="B"/> 
<item id="pic3" label="pic3" imageMso="C"/> 
<item id="pic4" label="pic4" imageMso="D"/> 
<item id="pic5" label="pic5" imageMso="E"/> 
<item id="pic6" label="pic6" imageMso="F"/> 
</gallery> 
</group> 
</tab> 
</tabs> 
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</ribbon> 
</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-38 所 示 。 


围 日 9- eo-s 

| = i 
0 

A picl B pic2 

C pic3 D pic4 

E pic5 F pic6 


图 5-38 使 用 图 片 库 


如 果 更 改 rows="3" columns="2" 为 rows="2" columns="3"， 则 效果 如 图 5-39 所 示 。 


面 日 5- 5 
| = 和 7 和 江 9 讽 。 宙 四 和 IT | 扩 民 0 能 
G 图库 
A picl B pic2 C pic3 
D pic4 E pics F pic6 
3 行列 
65 XxX vv f 
A B © D | 于 r | 了 
图 5-39 更改 图 片 库 的 行列 数 


此 外 ,还 可 以 设置 itemWidth 和 itemHeight 来 更 改 子 元 素 的 尺寸 。 更 改 gallery 的 属性 
为 如 下 形式 。 


<gallery id="Galleryl"” label=" 我 的 图 库 "” imageMso="G" rows="3" columns="2" size= 
"large" itemWidth="30" itemHeight="30"> 
与 上 述 XML 对 应 的 Excel 界面 如 图 5-40 所 示 。 


图 日 -er 


| = i 


or 
内 pc 日 pc 
C pe D pa MA = 
Ei 了 下 F SH 
E pcs F pc 
图 5-40 更 改 项 目的 宽度 、 高 度 


gallery 除了 显示 imageMso 指 代 的 内 置 图 像 外 ， 还 可 以 显示 计算 机 中 的 自 定 义 图 片 。 
5.3.15 菜单 


菜单 (menu) 元 素 也 是 一 种 容器 控件 ， 下 面 可 以 放置 button、checkBox 等 简单 控件 ， 也 可 
以 使 用 menuSeparator 作为 菜单 项 的 分 隔 线 ， 还 可 以 在 menu 之 下 再 放置 menu 元 素 作为 子 菜单 。 
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下 面 的 XML 在 group 下面 添 加 一 个 menu，menu 下 面 放置 一 个 button， 然 后 放置 一 个 
菜单 分 隔 线 ， 再 放置 一 个 按钮 。 
接 下 来 在 menu 中 再 创建 一 个 menu 作为 子 菜单 ， 该 子 菜单 下 面 放置 两 个 checkBox。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromSscratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019"” label=" 菜单 控件 "> 
<menu id="Menul" label=" 东北 地 区 "> 
<button id="Buttonl"” label=" 黑龙 江 省 "/> 
<menuSeparator id="Separatorl" /> 
<button id="Button2" label=" 吉林 省 "/> 
<menu id="Menu2"” label=" 辽宁 省 "> 
<checkBox id="Checkl" label=" 沈阳 市 "/> 
<checkBox id="Check2" label=" 大 连 市 "/> 
</menu> 
</menu> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-41 所 示 。 


公式 数据 市 网 视图 开发 I 具 扩展 功能 


图 5-41 添加 自 定义 级 联 菜单 
可 以 看 到 “吉林 省 ”这 个 按钮 上 方 有 一 分 隔 线 。 


5.3.16 ”分裂 按钮 


分 型 按钮 ( splitButton) 与 menu 相似 ， 但 是 比 menu 稍稍 复杂 。 可 以 把 splitButton 理 
解 为 一 个 button 和 一 个 menu 的 组 合体 。 例 如 【开始 /剪贴 板 】 中 的 “复制 ”就 是 一 个 
splitButton， 既 可 以 直接 单 击 该 控件 的 主体 按钮 部 分 ， 也 可 以 单 击 右 侧 小 箭头 ， 随 后 可 以 弹 
出 子 菜单 ， 如 图 5-42 所 示 。 

splitButton 的 XML 结构 如 图 5-43 所 示 。 

下 面 的 XML 创建 了 一 个 splitButton， 然 后 添加 一 个 “常规 早餐 ”的 按钮 ， 在 按钮 下 面 
增加 一 个 菜单 ， 该 菜单 中 包含 两 个 复 选 框 。 
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图 5-42 内置 分 裂 按钮 图 5-43 ”splitButton 的 XML 结构 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tab2018"” label=" 扩展 功能 "> 
<group id="Group2019"” label=" 分 裂 菜 单 控件 "> 
<splitButton id="Splitl"> 

<button id="Buttonl"” label=" 常规 早餐 "/> 

<menu id="Menul"> 
<checkBox id="Checkl" label=" 加 牛奶 "/> 
<checkBox id="Check2" label=" 加 鸡蛋 "/> 


</menu> 
</splitButton> 
</group> 
</tab> 
</tabs> 
</ribbon> 


</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-44 所 示 。 
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图 5-44 添加 自 定义 分 裂 按钮 


5.3.17 ”动态 菜单 


动态 菜单 ( dynamicMenu) 和 menu 在 外 观 上 都 是 菜单 ， 但 是 实现 原理 非常 不 同 ， 前 面 
讲 过 ， 制 作 menu 时 ， 需 要 把 menu 下 面包 含 的 控件 以 XML 代码 的 形式 包含 在 menu 元 素 之 
下 。 而 dynamicMenu 则 是 customUI 加 载 后 ， 后 期 可 以 增删 菜单 中 的 项 目 。 

dynamicMenu 控件 必 不 可 少 的 回调 是 getContent， 而 getContent 对 应 的 回调 函数 必须 返 
回 一 段 以 <menu> 为 根 节点 的 XML 代码 方 可 。 

“实例 文档 28.xlsm” 的 customUI 的 XML 代码 如 下 。 
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<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="customUI Load"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 "> 
<group id="Groupl” label=" 动态 菜单 "> 
<dynamicMenu id="Dynamicl”label=" 城市 名 称 ”getContent= "GetXML"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


可 以 看 到 ，group 下 面具 有 一 个 dynamicMenu 控件 ， 其 getContent 回调 函数 是 GetXML 
函数 ， 因 此 VBA 代码 如 下 。 


' 添加 外 部 引用 Microsoft XML v6.0 

Public R As Office.IRibbonUI 

Public Sub customUI_Load (ribbon As office.IRibbonUI) 
Set R = ribbon 

End Sub 


Public Sub GetXML (control Rs Office.IRibbonControl, ByRef content) 
Dim x Rs New MSXML2 .DOMDocument, Root As MSXML2 .IXMLDOMElement 
Dim E As MSXML2.IXMLDOMElement, i As Integer 
With x 
Set Root = x.createElement ("menu") 
Root.setAttribute "xmlns", "http://schemas.microsoft.com/office/2009/07/ 


customui™ 
Set x.DocumentElement = Root 
For i = 2 To Sheetl.Range ("Al") .End (xlDown) .Row 
Set E = x.createElement (Sheetl.Range ("A" & i) .Value) 
With E 
.setAttribute "id", Sheetl.Range("B" & i).Value 
.SetRAttribute "label", Sheetl.Range("C" & i) .Value 
.SetRAttribute "tag", Sheetl.Range("D" & i) .Value 
.SetAttribute "onAction", Sheetl.Range("E" & i).Value 
End With 
Root .appendChild E 
Next i 
content = x.XML 
End With 
End Sub 


Public Sub OA(control As Office.IRibbonControl) 
MsgBox control.Tag 

End sub 

Sub Update() 
R.InvalidateControl "Dynamicl™" 

End Sub 
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代码 分 析 : GetXML 函数 使 用 第 4 章 讲 过 的 VBA 自动 生成 XML 的 方式 ， 从 工作 表单 
元 格 中 的 预先 设 定数 据 生 成 XML 字符 串 ， 最 后 赋 给 GetXML 函数 。 

打开 该 工作 簿 ， 编 辑 工作 表 中 的 数据 ， 单 击 工 作 表 上 的 “更 新 菜单 ”按钮 ， 会 看 到 城市 
名 称 菜单 中 的 项 目 会 随 之 变化 ， 如 图 5-45 所 示 。 


[mE Er | 
城市 名 称 " 

河北 

山东 

安 和 

漳 北 - -a 

| By | | D | ; Fr Wa 1 
1 leontrol id label tag onAction 
2 _jbutton controll 河北 tagl Ok 
3 jbutton control2 山东 tag2 Ok 要 新 条 单 
4 jbutton control3 安徽 tag3 DA 
5 jbutton control4 湖北 tag4 Og 
6 
7 

图 5-45 动态 菜单 


关于 如 何 刷新 功能 区 ， 可 以 参考 5.4.10 节 和 5.4.11 节 。 
5.3.18 ”对 话 框 


一 般 情况 下 ，button 直属 于 group 之 下 ， 并 且 每 个 button 都 会 占据 group 中 的 一 个 位 置 。 
使 用 对 话 框 (dialogBoxLauncher) 元 素 可 以 把 一 个 button 置 于 组 的 右 下 角 ， 以 小 箭头 呈现 。 
当 用 户 单 击 右 下 角 的 小 箭头 时 ， 就 相当 于 单 击 了 这 个 button， 也 就 是 说 dialogBoxLauncher 
元 素 本 身 没 有 任何 回调 。 

dialogBoxLauncher 的 使 用 非常 简单 ， 它 的 父 级 元 素 必须 是 group， 它 的 子 元 素 必须 是 
button， 而 且 只 能 是 一 个 button。 而 日 一 个 group 之 下 最 多 允许 一 个 dialogBoxLauncher。 

下 面 的 XML 代码 ,在 group 之 下 放置 一 个 dialogBoxLauncher 元 素 ， 然 后 放 先 一 个 


button 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id-="Tab2018"” label=-" 扩展 功能 "> 
<group id="Group2019"” label=" 对 话 框 "> 
<dialogBoxLauncher> 
<button id="Buttonl" onAction="ShowMyForm" /> 
</dialogBoxLauncher> 
</group> 
</tab> 
</tabs> 
</ribbon> 


</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-46 所 示 。 


当 单 击 右 下 角 的 小 箭头 后 ， 正 常情 况 下 会 调用 VBA 中 的 ShowMyForm 过 程 。 本 例 由 于 
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Em 二 插入 。 页 本 布局 。 公式。 数 生 。 市 网。 视图 ”开发 T 具 | 扩展 功能 


RibbonTest for Excel 14.0 中 的 自 定义 UI 运行 时 错误 


@ 未 找到 回调 函 数 “ShowMyForm” 


Cw | [smew | 


图 5-46 组 右 下 角 的 对 话 框 控件 


没有 书写 相应 的 回调 ， 弹 出 了 “ 自 定义 UI 运行 时 错误 ”， 这 属于 正常 现象 。 


5.4 常用 属性 详解 


用 于 自 定义 功能 区 的 XML 代码 中 ， 每 个 元 素 都 可 以 设置 诸多 属性 来 控制 控件 的 实际 
显示 风格 。 因 此 ， 除 了 前 面 介绍 过 的 id 和 label 属性 之 外 ， 还 需要 了 解 更 多 重要 属性 ， 如 表 


T 


5-2 所 示 。 
表 5-2 customUI 属 性 及 含义 ( 按 字母 排序 ) 
属 性 类 型 或 取 值 描述 
description 文本 当 menu 中 的 itemSize 属性 设置 为 large 时 显示 的 描述 文本 
enabled tme, false, 0, 1 “| 规定 控件 是 否 可 用 
getContent 回调 只 用 于 动态 菜单 (dynamicMenu)， 设 置 返回 的 动态 XML 代码 
getDescription 回调 动态 设置 控件 的 描述 文本 
getEnabled 回调 动态 设置 控件 的 可 用 性 
getImage 回调 动态 设置 控件 的 图 标 
getImageMso 回调 动态 设 先 控件 的 内 兽 图 标 
getItemCount 回调 动态 设置 容器 控件 (comboBox 、dropDown 、gallery) 包含 的 子 项 总 数 
getItemID 回调 动态 设置 容器 控件 (comboBox 、dropDown 、gallery) 包含 的 子 项 的 id 
动态 设置 容器 控件 、 、 含 的 子 项 的 
em 回调 动态 设置 容器 控件 ( comboBox 、dropDown 、gallery) 包含 的 子 项 的 
图 标 
动态 设置 容器 控件 ( comboBox 、dropDown 、gallery) 包含 的 子 项 的 
getItemLabel 回调 本 
标题 
动态 设置 容器 控件 ( comboBox 、dropDown 、gallery) 包含 的 子 项 的 
getItemScreentip 回调 " 
screenTip 
元 态 i :3 今 的 项 
Se 回调 动态 设置 容器 控件 (comboBox 、dropDown 、gallery) 包含 的 子 项 的 
superTip 
getKeytip 回调 动态 设置 控件 的 KeyTip 
getLabel 回调 动态 设置 控件 的 标题 文字 
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续 表 
属 性 描 述 
getPressed 动态 设置 checkBox 、toggleButton 控件 的 按 下 状态 
getScreentip 动态 设置 控件 的 screenTip 属性 


getSelectedItemID 对 于 dropDown 或 gallery 控件 , 动态 设置 所 选 条 目的 id 


getSelectedItemIndex | 回调 对 于 dropDown 或 gallery 控件 , 动态 设置 所 选 条 目的 序号 
getShowImage 回调 动态 设置 是 否 显示 图 标 


getShowLabel 动态 设置 是 否 显示 标题 文字 

getSize 动态 设置 控件 的 尺寸 ， 是 normal 还 是 large 

getSupertip 受 署 控件 的 superTip 属性 

getText 动态 设置 editBox 控件 的 文本 

getTitle 对 于 menu 中 的 menuSeparator 控件 ， 动 态 设置 其 标题 
getVisible 设置 控件 的 可 见 性 

id -识别 号 ， 不 可 与 idMso 、idQ 同时 使 用 


idMso 控件 编号 内 鞠 控 件 的 唯一 识别 号 
idQ 指定 命名 空间 的 控件 识别 号 
image 规定 控件 的 图 标 


imageMso 控件 编号 规定 控件 显示 内 园 图 标 

insertAfterMso 控件 编号 规定 置 于 哪 一 个 内 置 控件 之 后 

insertBeforeMso 控件 编号 规定 置 于 哪 一 个 内 普 控件 之 前 

itemSize 对 于 menu， 规 定 其 子 项 的 尺寸 

keytip [x | 规定 控件 的 快捷 键 ， 按 下 Alt 键 显 示 快捷 键 提示 


label EN 规定 控件 的 标题 
onAction 当 单 击 控件 时 触发 的 过 程 


onChange 回调 当 修改 comboBox 、editBox 内 容 时 触发 的 过 程 

screentip 规定 控件 的 screenTip 

showImage 规定 是 否 显示 图 标 

showItemImage 用 于 comboBox 、dropDown 、gallery 控件 ,规定 是 否 显 示 子 项 的 图 标 


showItemLabel 用 于 comboBox 、dropDown 、gallery 控件 ， 规 定 是 否 显示 子 项 的 标题 


showLabel tme，false，0，1 | 规定 是 否 显示 控件 的 标题 
size large, normal 规定 控件 的 尺寸 


sizeString 暗示 editBox 的 宽度 


supertip 规定 控件 的 superTip 属性 

tag 用 户 自 定义 文本 ， 一 般 用 来 区 分 不 同 的 控件 

title 用 于 menu 中 的 menuSeparator 控件 ， 规 定 其 标题 
visible 规定 控件 的 可 见 性 


属性 从 控件 来 源 可 以 划分 为 自 定义 属性 和 内 置 属性 。 例 如 规定 一 个 控件 的 属性， 说 
明 该 控件 是 自 定义 的 ; 如 果 规 定 一 个 控件 的 imageMso 属性 ， 说 明 该 图 像 来 源 于 Office 内 置 
图 标 。 
属性 从 作用 原理 上 可 以 划分 为 直接 属性 和 回调 属性 。 例 如 控件 的 label 属性 就 是 一 
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性 规定 这 个 控件 的 标题 文字 ， 后 期 不 得 更 改 。 而 规定 控件 的 getLabel 属性 ， 就 意味 着 该 控 
件 的 标题 文字 可 以 由 VBA 代码 产生 。 很 多 以 get 开头 或 者 on 开头 的 属性 都 是 回调 属性 ， 
也 就 是 说 ， 如 果 在 XML 代码 中 使 用 了 回调 属性 ， 那 么 在 VBA 代码 中 一 定 要 有 相应 的 回调 
函数 来 呼应 。 

下 面 把 相似 的 属性 放 在 一 起 对 比 讲解 。 


5.4.1 id-idMso 


id 属性 是 自 定义 元 素 的 唯一 识别 符 ，tab 元 素 及 其 以 下 几乎 都 需要 规定 id 值 ， 也 有 个 别 
的 不 需要 id， 例 如 dialogBoxLauncher。 

idMso 的 作用 是 引用 Office 内 置 元 素 。 

Office 2013 常用 组 件 的 idMso 可 以 使 用 笔者 制作 的 O 角 ceidMsoViewer 软件 来 快速 查询 
和 获取 ， 如 图 5-47 所 示 。 


ET 
Excel_2013_tabs_en 白 - 食 : 有 - 
Excel-2013-tabs_ jp 国 tab idyso=“TabHone”l1abe 
backstage_cn 呈 生 用 
int-2013-beckstage_en 宙 国 CsplitButton idyso=*PasteNenu”1lebel=“ 粘 贴 "》 
Ce 13_backstage_jip 思 button idMso="Cut” label= “前 切 ”> _ 
poverPoint_2013-0 四 - 国 csplitButton idMso="CopySplitButton”label=" 复 制 "> 
IPowerPoi 2013- contextMenus_jp 国 ‘control idMso=“FormatPainter”label=“ 格 式 刷 ”> 
ome point lonet on 至- 国 cdialogBoxLaunchery 
IPowerPoint. 加 Ceroup idMso=”GroupFont”label=" 字 体 ">》 
EoverPolt. 各 | ceroup idMso=“GroupAlignmentExcel”label=" 对 齐 方式 "》 
owerPoin' CroupNunber” -= 数字" 
tet GroupNumber”1abel=" 数 字 ”》 


“GroupStyles”1label=" 样 式 "》 
“GroupCel1s”label="* 单 元 格 "> 

国 group idMso="GroupEditingExcel”1label= 编辑 "> 
国 (tab idyso="TabJInsert”]label=" 插 入 "> 

图 tab idyso="TabPageLayoutExcel”label=" 页 面 布局 "> 
重 ] ctab iduso="TabFormulas”label=" 公 式 ” 

信 ctab iduso=”TabData”label=" 数 据 "》 

全 | ‘tab idyso="TabReview” label= “审阅 "> 

全 tsb ia 对 


<tabs>/dtab idyso="TabHome” label i 


图 5-47 OfficeidMsoViewer 界面 
单 击 右 侧 树 状 结构 中 任意 一 个 节点 时 ， 会 立即 生成 该 节点 对 应 的 XML 代码 。 
例如 ， 在 新 的 自 定义 tab 中 引用 内 置 的 GroupFont、GroupNumber 和 GroupCells， 可 以 
使 用 如 下 XML 代码 。 


PowerPoint-2013-t 
PowerPoint-2013_tabSet_en 
PowerPoint-2013_tabSet_jp 
Word_2013_backstage_en 
[Word_2013_backstage_en 
Word_2013_backstage_ip 
contextMenus_cn 
contextMenus_en 
contextMenus_jp 


团 厂 丁丁 由 四 


国 中 图 图 加 


用 


i 和 LE 区 网 折 5 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 

<tab id="Tabl"” label=" 扩展 功能 "> 
<group idMso="GroupFont"> 
</group> 
<group idMso="GroupNumber"> 
</group> 
<group idMso="GroupCells"> 
</group> 

</tab> 
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</tabs> 
</ribbon> 
</customUI> 
可 以 看 到 以 上 3 个 内 中 组 出 现在 “扩展 功能 ” 自 定义 选项 卡 中 ， 如 图 5-48 所 示 。 
图 日 操心 : 
| = Ei 
EE Em ED sad 
BIU-| 田 - |- A 次 -| 因 - %:，| 久 加 | 二、 柜 
字体 6 数字 6 单元 格 
|H6 vii|x v 大 四 
图 5-48 自 定义 选项 卡 中 引用 内 置 组 


同一 个 元 素 不 能 同时 使 用 id 和 idMso 属性 。 


5.4.2 insertBeforeMso-lnsertAfterMso 


InsertBeforeMso 是 指 该 元 素 位 于 指定 的 内 置 元 素 之 前 。insetAfterMso 是 之 后 。 
例如 ，<tab id="Tabl" label=" 扩展 功能 " insertAfterMso="TabHome"> 是 指 创建 一 个 新 选 


项 卡 ， 该 选项 卡 处 于 内 置 选项 卡 “开始 ”的 后 面 。 
下 面 的 XML 代码 能 在 “开始 ”选项 卡 之 后 新 建 一 个 自 定义 空白 选项 卡 。 然 后 在 “开始 ” 
内 置 选 项 卡 的 “数字 ”内 置 组 之 前 创建 一 个 自 定义 组 。 
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 " insertAfterMso="TabHome"> 


</tab> 
<tab idMso="TabHome"> 
<group id="Groupl"” insertBeforeMso="GroupNumber” label=" 自 定义 组 "> 


<button id="Buttonl"” label=" 自 定义 按钮 "/> 


</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 
与 上 述 XML 对 应 的 Excel 界面 如 图 5-49 所 示 。 
| IrE1 - Bed 
| = EE 
-I -]A Bens | lam -| 瞩 
-| 王 坪 车 全 HE 中 国 -%，| 人 说 部 | 2 过 
EE E22] | 6 二 自 定 X 组 Es3 和 
| B19 xX vv 天 


图 5-49 前 后 位 置 调整 
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5.4.3 _ enabled-getEnabled 


enabled 属性 指 的 是 元 素 的 有 效 性 ， 取 值 可 以 是 tue ( 1 ) 或 者 false ( 0 )。 
getEnabled 是 回调 属性 ， 元 素 的 有 效 性 取决 于 VBA 返回 的 结果 。 
例如 ， 在 XML 中 规定 两 个 button， 设 置 不 同 的 enabled 属性 。 


<button id="Buttonl"” label=" 自动 转换 " enabled="false"/> 
<button id="Button2"” label=" 手工 转换 " enabled="1"/> 


Excel 中 可 以 看 到 “自动 转换 ”这 个 button 是 灰色 不 可 用 的 ， 如 图 5-50 所 示 。 


日 5- SG- I - Excel 
| = 和 ma 全。 SEE 讽 。 桥 。 向 IT 有 4 哮 硕 。 国人 | 扩展 功能 


B19 -| x w 天 
图 5-50 控件 的 可 用 性 
使 用 getEnabled 属性 可 以 智能 地 由 VBA 过 程 来 决定 控件 是 否 可 用 。 
“实例 文档 16.xlsm” 中 包含 了 下 面 的 XML 代码 和 VBA 代码 ， 用 于 演示 getEnabled 
功能 。 
XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 "> 
<group id="Groupl”label=" 高 级 技术 "> 
<button id="Buttonl" label=" 自动 转换 ”getEnabled="Button 


Enabled"/> 
<checkBox id="Checkl"” label=" 递归 算法 " getEnabled="Check_ 
Enabled"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


以 上 两 个 控件 相应 的 VBA 回调 如 下 。 


Public Sub Button_Enabled(control As Office.IRibbonControl, ByRef enabled) 
enabled = True 

End sub 

Public Sub Check Enabled(control As Office.IRibbonControl, ByRef enabled) 
Dim flag As Boolean 
Randomize 
flag = Rnd() > 0.5 
enabled = flag 

End Sub 
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代码 分 析 : 回调 函数 中 的 ByRef enabled 是 一 个 布尔 值 ， 用 于 决定 控件 的 可 用 性 ， 
回调 函数 中 要 更 改 该 参数 的 取 值 。 


因此 


本 例 中 由 于 按钮 的 enabled=True， 复 选 框 的 enabled 取决 于 flag 的 值 ， 而 flag 是 用 随机 


数 和 0.5 比较 大 小 ， 因 此 复 选 框 有 两 种 随机 状态 : 可 用 或 不 可 用 。 


在 Excel 中 打开 该 文档 ， 加 载 customUI 的 同时 ,会 自动 运行 标准 模块 中 的 相关 回调 函 


数 ，Excel 中 的 效果 如 图 5-51 所 示 。 


当 关 闭 该 文档 ， 再 次 打开 时 ， 复 选 框 或 许 会 ”[ 面 王 


变 得 可 用 。 [Ee 3 最 6 能 
从 以 上 实例 可 以 看 出 控件 的 enabled 属性 不 依 | 
赖 于 VBA 中 的 回调 ， 而 是 在 XML 直接 指定 控件 “| 二 之 = 


是 否 可 用 。 而 getEnabled 属性 则 需要 根据 VBA 过 图 5-51 VBA 中 变量 的 值 决定 控件 是 否 


程 中 参数 的 返回 值 来 决定 控件 是 否 可 用 。 可 用 


5.4.4 visible-getVisible 


visible 是 在 XML 中 直接 指定 元 素 显示 或 隐藏 ， 而 getVisible 则 依赖 于 VBA 回调 函数 。 
“实例 文档 17.xlsm” 的 XML 代码 中 ，group 、button 、checkBox 都 用 getVisible 来 设置 


元 素 的 可 见 性 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 "> 


<group id="Groupl"” label=" 高 级 技术 " getVisible="Group_Visible"> 
<button id="Buttonl"” label=" 自动 转换 "getVisible="Button Visible"/> 
<checkBox id="Checkl”label=" 递归 算法 "” getVisible="Check Visible"/> 


</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


相应 的 VBA 回调 函数 如 下 。 


Public Sub Group Visible(control Rs Office.IRibbonControl, ByRef visible) 
visible = True 

End Sub 

Public Sub Button Visible(control As Office.IRibbonControl, ByRef visible) 
visible = False 

End Sub 

Public Sub Check Visible (control Rs Office.IRibbonControl, ByRef visible) 
visible = True 

End Sub 


代码 分 析 : 回调 函数 中 的 ByRef visible 参数 用 于 决定 控件 是 否 可 见 。 本 例 把 Button 的 
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visible 设置 为 False， 因 此 在 Excel 中 看 不 到 该 按 Ls 
EN 扩展 功能 
钮 ， 如 图 5-52 所 示 。 口 党 
visible-getVisible 除了 可 以 显示 /隐藏 group 
高 级 技术 
下 面 的 控件 外 ， 还 可 以 隐藏 内 置 选项 卡 、 组 、 控 [oe -|i[x vA| 
件 等 。 图 5-52 ”getVisible 属性 的 应 用 


例如 下 面 的 XML 首先 隐藏 “开始 ”选项 卡 
中 的 “字体 ”组 ， 然 后 隐藏 “公式 ”选项 卡 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab idMso="TabHome"> 
<group idMso="GroupFont" visible="false"> 
</group> 
</tab> 
<tab idMso="TabFormulas" visible="false"> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


与 上 述 XML 对 应 的 Excel 界面 如 图 5-53 所 示 。 


至 大 。 市 网 视图 开发 IT 内 。 加 载 顶 国 队 


Ey 
EE | 汪 规 - 腊 E 罗 
-| 加 - 9 加 件 格式 。 可 
EB % 网 加 | 个 式 
盘 贴 板 上 对 开 方 式 后 数字 后 


M19 "|i[x v 大 


图 5-53 使 用 visible 属性 决定 可 见 性 


注意 并 非 所 有 内 置 元 素 都 可 以 修改 其 各 种 属性 。 


5.4.5 label-getLabel 


label 是 元 素 的 静态 属性 ， 用 于 多 种 元 素 ， 例 如 tab、group、button 等 可 以 设置 label 属性 ， 
用 来 设置 控件 的 标题 文字 。 

与 label 属性 对 应 的 回调 属性 是 getLabel。 

“实例 文档 18.xlsm” 中 的 XML 如 下 所 示 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromSscratch="false"> 
<tabs> 
<tab id="Tabl" getLabel="Tab Label"> 
<group id="Groupl" getLabel="Group Label"> 
<labelControl id="Labell" getLabel="Label Label"/> 
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</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


相应 的 VBA 回调 函数 如 下 。 


Public Sub Tab Label (control As Office.IRibbonControl, ByRef label) 
label = Now 

End sub 

Public Sub Group Label (control As Office.IRibbonControl, ByRef label) 
label = Date 

End Sub 

Public Sub Label Label (control As Office.IRibbonControl, ByRef label 
label = Time 

End Sub 


代码 分 析 : XML 中 包含 tab 、group 、labelControl 三 个 元 素 ， 每 个 元 素 的 标题 属性 都 是 
动态 的 ， 取 决 于 VBA 中 的 回调 函数 。 

各 个 回调 函数 中 的 参数 control 是 指控 件 本 身 ， 而 label 是 指 返回 的 标题 。 

打开 该 工作 簿 ， 可 以 看 到 各 个 元 素 分 别 显示 了 当前 的 日 期 和 时 间 ， 如 图 5-54 所 示 。 


印 日 -ce:e@: 实例 文档 18xdsm - Excel 
EE i A i FIR | 2018/1/14152421 
15:24:23 


2018/1/14 


J6 由 xx vv Ef£ 
图 5-54 ”getLabel 属性 的 应 用 
细心 的 读者 可 能 发 现 以 上 三 个 回调 函数 的 结构 是 一 样 的 ， 不 同 的 是 回调 函数 名 不 同 。 其 
实 ， 如 果 回 调 函 数 的 参数 个 数 、 各 参数 类 型 一 样 ， 多 个 控件 可 以 共享 同一 个 回调 函数 。 
“实例 文档 19.xlsm” 中 的 XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl" getLabel="ReturnLabel"> 
<group id="Groupl" getLabel="ReturnLabel"> 
<labelControl id="Labell" getLabel="ReturnLabel"/> 
<button id="Button2" getLabel="ReturnLabel"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


可 以 看 到 XML 中 的 4 个 元 素 的 getLabel 指向 同一 个 回调 函数 : RetumLabel。 因 此 在 
VBA 中 只 须 创建 一 个 回调 函数 即 可 。 
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Public Sub ReturnLabel (control As Office.IRibbonControl, ByRef label) 
Select Case control.ID 


Case "Tabl": label = "工作 短 " 

Case "Groupl": label = "工作 表 " [Ba 

Case "Labell": label - "单元 格 " ES 

Case Else: label = "其 他 …… H 单元 格 

End Select 其 地 -~ 
End sub 

工作 表 
不 同 控件 的 i 一 定 不 同 ， 因 此 借助 控件 的 id 属性 或 者 tag | "| 
属性 的 区 别 , 用 焉 或 Select 结构 区 分 开 即 可 。 图 5-55 多 个 控件 共用 

与 上 述 XML 对 应 的 Excel 界面 如 图 5-55 所 示 。 同一 个 回调 函数 


5.4.6 imageMso-image-getlmage 


button、menu 等 元 素 都 支持 图 标 ， 为 控件 设置 图 标 有 三 种 方式 ， 其 中 image 和 
imageMso 是 静态 属性 。getImage 是 回调 属性 ， 使 用 VBA 过 程 为 控件 指定 图 标 。 

控件 的 图 标 可 以 是 Office 内 置 图 标 (imageMso) 或 者 计算 机 中 的 图 片 文件 。 

imageMso 与 前 面 讲 过 的 idMso 有 一 定 的 联系 ， 例 如 要 在 XML 中 引用 Excel 2013 的 
【插入 /符号 /符号 ] 这 个 Q 形状 的 按钮 ， 如 图 5-56 所 示 。 
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图 5-56 引用 内 置 控件 的 图 标 
使 用 OfficeidMsoViewer 软件 可 以 快速 看 到 该 控件 的 XML， 如 图 5-57 所 示 。 


《customUI xmlns="http://schemas. mcrosoft. com/office/2009/07/customi”> 


ribbon startFromScratch="false”> 
<tabs> 
tab idlso="TabInsert”> 
I 《group idllso=“Crouy 


</group> 
<Vtab> 
《/tabs> 
</ribbon> 
/customUI> 


图 5-57 查询 内 置 控 件 的 idMso 


图 中 可 以 看 到 9 的 idMso 是 SymbolInsert， 那 么 以 后 创建 的 自 定义 控件 ， 其 imageMso 
属性 如 果 也 指定 为 SymbolInsert， 那 么 这 个 新 控件 的 图 标 也 是 Q 。 

下 面 的 XML 代码 产生 的 按钮 的 图 标 就 是 Q 。 

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 


<ribbon startFromSscratch="false"> 
<tabs> 
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<tab id="Tabl"” label=" 扩展 功能 "> 

<group id="Groupl”label=" 图 标 设 定 "> 
<button id="ButtonID3” label=" 我 的 符号 " imageMso="SymbolInsert"/> 

</group> 

</tab> 

</tabs> 
</ribbon> 
</customUI> 


以 上 XML 代码 对 应 的 Excel 界面 如 图 5-58 所 示 。 


围 日 595- -Os 工作 筹 11 - Excel 

开始 插入 页面 布 局 公式 数 晤 证 网 ”视图 。 开发 T 具 国 队 扩展 功能 
人 我 的 符号 
图 标 设 定 


图 5-58 使 用 内 置 控件 的 idMso 


因此 ， 只 需要 设 定 imageMso 属性 ， 控 件 的 图 标 就 显示 为 Office 内 置 图 标 。 不 同 版 本 
Office 的 内 置 图 标的 名 称 和 数量 也 不 同 ，Ofce 2010 和 Office 2013 大 约 有 一 万 个 可 以 使 用 的 
内 置 图 标 。 

笔者 制作 的 imageMso7345.xlsm 可 以 快速 查找 所 有 内 置 图 标的 名 称 和 外 观 ， 如 图 5-59 
所 示 。 
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图 5-59 内置 图 标 查看 器 
在 这 些 内 置 图 标 中 ， 有 一 些 是 比较 简单 的 图 标 ， 例 如 26 个 大 写 英 文字 母 A ~ Z, 使 用 
imageMso="M"， 图 标 就 显示 为 M。 还 可 以 使 用 0 ~ 9 这 10 个 数字 作为 图 标 ， 但 是 前 面 要 加 
下 画 线 。 
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1. 使 用 Office 内 置 图 标 
下 面 的 XML 代码 使 用 字母 和 数字 作为 按钮 的 图 标 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="true"> 
<tabs> 
<tab id="Tabl" label=" 扩展 功能 "> 

<group id="Groupl" label=" 字母 图 标 "> 
<button id="Buttonl" label="x" imageMso="X"/> 
<button id="Button2" label="y" imageMso="Y"/> 
<button id="Button3" label="z" imageMso="2"/> 

</group> 

<group id="Group2"” label=" 数字 图 标 "> 
<button id="Button4" label="0" imageMso=" 0"/> 
<button id="Button5" label="1l" imageMso=" 1"/> 
<button id="Buttoné" label="2" imageMso=" 2"/> 


</group> ES 
</tab> > 
</tabs> 太太 功能 
</ribbon> Xx 00 
</customUI> Yy 11 
六 EB] 
以 上 XML 代码 对 应 的 Excel 界面 如 图 5-60 所 示 。 字母 图 标 数字 图 标 
2， 使 用 自 定义 图 标 本 ] 


image 属性 规定 可 以 使 用 自 定 义 图 片 作为 控件 的 图 标 ， ”图 5-60 数字、 字母 作为 图 标 
而 不 是 Office 内 置 图 标 。 下 面 讲 解 用 Custom UI Editor for Microsoft Office 软件 向 Office 文 
档 中 压 人 自 定义 图 片 并 应 用 于 功能 区 控件 中 。 

在 Excel 2013 中 新 建 一 个 空白 工作 短 ， 另 存 为 “实例 文档 20.xlsm”， 然 后 关闭 该 工作 
短文 件 。 

启动 Custom UI Editor 软件 ， 单 击 菜单 【 File/Open ]， 打 开 “ 实 例文 档 20.xlsm”。 为 了 
编写 XML 代码 ， 需 要 再 单 击 菜单 【 Insert/Office 2010 Custom UI Part ]， 在 右 侧 出 现 的 编辑 
区 写 入 如 下 XML 代码 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id-="Tabl”label-" 扩展 功能 "> 
<group id="Groupl"” label=" 棋子 "> 
<button id="Buttonl" label=" 仕 " size="large" image="shi"/> 
<button id="Button2" label=" 帅 " size="large" image="shuai"/> 
<button id="Button3" label=" 仕 " size="large" image="shi"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


编写 过 程 如 图 5-61 所 示 。 
注意 代码 中 3 个 Button 的 image 属性 ， 因 此 还 需要 向 该 文档 中 添加 相应 名 称 的 png 格 
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式 图 片 。 
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图 5-61 编写 XML 代码 


再 次 单 击 软件 的 菜单 【 InsertTcons 】])， 浏 览 并 选择 计算 机 中 的 两 个 png 图 片 : shipng 和 
shuai.png。( .png 图 片 可 以 从 网 上 下 载 ， 或 者 把 其 他 图 片 用 图 片 工具 转换 为 .png 格式 也 行 。) 

此 时 通过 左 侧 树 状 结构 可 以 看 到 加 入 了 两 个 自 定义 图 片 ， 图 片 的 id 分 别 为 shi 和 shuai， 
如 图 5-62 所 示 。 
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图 5-62 加 入 自 定义 图 片 


编写 好 XML 代码 并 添加 了 图 片 后 ， 就 可 以 单 击 【 File/Save 】 保 存 文档 ， 然 后 单 击 
【 File/Close 】 从 软件 中 关闭 工作 短 (如 果 不 关 闭 ， 在 Excel 中 没 法 打开 )。 
然后 在 Excel 中 打开 “实例 文档 20.xlsm”， 如 图 5-63 所 示 。 
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5-63 加 入 了 自 定义 图 标的 效果 
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如 果 后 期 需要 对 XML 、 图 标 进行 变更 ， 可 以 继续 使 用 Custom UI Editor 这 个 软件 打 
开 文 档 。 


3. 使 用 getImage 动态 改变 图 标 

getImage 可 以 通过 VBA 回调 函数 为 控件 动态 设 定 图 标 。 图 标的 来 源 可 以 是 Ofce 内 置 
图 标 ， 也 可 以 是 计算 机 中 的 图 片 文件 。 

“实例 文档 21.xlsm” 中 的 XML 代码 如 下 所 示 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 "> 
<group id="Groupl"” label=" 动态 图 标 "> 
<button id="Buttonl" label="Test" size="large" getImage= 
"GetJPG"/> 
<button id="Button2" label="Symbol" size="large" getImage= 
"UseBuiltin"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


该 XML 中 的 两 个 按钮 都 用 getImage 属性 通过 回调 函数 返回 图 标 ， 因 此 VBA 中 的 回调 
函数 如 下 。 


Public Sub GetJPG (control Rs Office.IRibbonControl, ByRef image) 
Set image = LoadPicture (ThisWorkbook.Path & "\images\test.jpg") 

End Sub 

Public Sub UseBuiltin (control As Office.IRibbonControl, ByRef image) 
image = "SymbolInsert" 

End Sub 


代码 分 析 : 回调 函数 中 的 参数 image 既 可 以 通过 LoadPicture 方法 装载 本 地 的 图 片 文件 ， 
也 可 以 传人 一 个 Office 内 置 图 标的 名 称 ， 其 中 SymbolInsert 就 是 内 置 图 标 Q 。 
打开 该 工作 短 ， 实 际 效果 如 图 5-64 所 示 。 
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E5 -x vv fF 
图 5-64 使 用 getImage 动态 获取 图 标 
前 面 讲 过 ，gallery 控件 通常 用 于 展示 图 片 ， 因 此 把 getImage 属性 应 用 于 gallery 控件 ， 
就 可 以 很 方便 地 在 功能 区 展示 计算 机 中 的 图 片 ， 也 可 以 制作 imageMso 查看 器 。 
还 可 以 看 出 ， 通 过 getImage 可 以 动态 地 加 载 计算 机 中 的 图 片 ， 无 须 像 image 属性 那样 
把 图 片 压 和 人 文档 中 。 
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5.4.7 showlmage-showLabel 


控件 的 诸多 属性 中 ， 有 一 些 属性 是 以 单词 show 开头 的 ， 这 些 属性 的 可 取 值 均 为 布尔 
值 ， 而 且 默 认 值 都 是 true。 

当 showImage 设置 为 false 或 0 时 ， 控 件 的 image、imageMso 或 getImage 设置 的 图 标 均 
不 显示 ， 也 就 是 隐藏 图 标 。 

当 showLabel 设置 为 false 或 0 时 ， 控件 的 Label 或 getLabel 设置 的 标题 文字 均 不 显示 ， 
也 就 是 隐藏 标题 文字 。 

当 控 件 的 size="large" 时 ， 即 使 以 上 两 者 都 设置 为 false， 也 不 会 隐藏 。 也 就 是 说 ， 以 上 
两 个 属性 只 有 当 size="normal" 时 有 效 。 

下 面 的 XML 代码 在 组 中 放置 了 3 个 按钮 ， 其 中 第 2 个 按钮 隐藏 图 标 ， 第 3 个 按钮 隐藏 
标题 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 "> 
<group id="Groupl"”1label=" 显示 和 隐藏 "> 
<button id="Buttonl"” label=" 笑脸 " imageMso="HappyFace"/> 
<button id="Button2"” label=" 笑脸 " imageMso="HappyFace" 
showImage="false"/> 
<button id="Button3" label=" 笑脸 " imageMso="HappyFace" 
showLabel="false"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


在 Excel 中 可 以 看 到 上 下 并 排 3 个 按钮 ， 第 2 个 按钮 没有 图 标 、 第 3 个 按钮 没有 标题 ， 
如 图 5-65 所 示 。 


图 5-65 ”图标 和 标题 的 隐藏 


5.4.8 onAction 


onAction 主要 用 于 规定 button 的 回调 函数 ， 例 如 onAction="Hello", 那么 当 单 击 该 按钮 
时 ,会 调用 VBA 中 的 Sub Hello 过 程 ， 如 果 不 为 button 规定 onAction 属性 ， 则 单 击 该 按钮 
没 任何 响应 ， 因 此 一 般 情 况 下 onAction 是 button 的 一 个 必 备 属性 。 
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“实例 文档 22.xlsm” 中 的 XML 如 下 : 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id-="Tabl"” label=" 扩展 功能 "> 
<group id="Groupl" label=" 动态 图 标 "> 
<button id="Buttonl"” label=" 启动 Word" imageMso="MindMap 
ExportWord" onAction="LaunchWord"/> 
<button id="Button2” label=" 启动 PowerPoint" imageMso= 
"MicrosoftPowerPoint" onAction="LaunchPPT"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


VBA 中 的 回调 函数 如 下 。 


Public Sub LaunchWord(control As Office.IRibbonControl) 
Application.ActivateMicrosoftApp xlMicrosoftWord 

End Sub 

Public Sub LaunchPPT(control As Office.IRibbonControl) 
Application.ActivateMicrosoftApp xlMicrosoftPowerPoint 


End Sub 和 
与 上 述 XML 对 应 的 Excel 界面 如 图 5-66 所 示 。 ci 
如 果 在 一 个 XML 中 存在 多 个 功能 相似 的 按钮 ， 可 以 把 Wt 

这 些 按钮 的 anAetion 设置 为 同一 个 VBA 过 程 ,VBA 过 程 ”区 | 


中 根据 控件 的 id 或 tag 属性 的 不 同 ， 从 而 执行 不 同 的 代码 。 图 5-66 ”按钮 的 回调 函数 
5.4.9 onChange-getText 


onChange 和 getText 属性 通常 用 于 文本 框 (editBox) 控件 。 

当 向 文本 框 中 输入 内 容 ， 引 起 文本 框 内 容 变 化 时 ,会 触发 onChange 指定 的 VBA 过 程 。 

默认 情况 下 ， 功 能 区 加 载 时 ， 各 个 文本 框 里 都 是 空白 的 , 但 是 可 以 使 用 getText 使 得 文 
本 框 能 够 自动 输入 内 容 。 

“实例 文档 23.xlsm” 中 的 XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl" label=" 扩展 功能 "> 
<group id="Groupl"” label=" 文本 框 "> 
<editBox id="Editl" label=" 姓名 : " maxLength="6" onChange= 
"ContentChanged" getText="UpdateText"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 
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其 中 maxLength 属性 规定 了 文本 框 最 多 输入 6 个 字符 。 
VBA 中 相应 的 回调 函数 如 下 。 


Public Sub ContentChanged (Control Rs Office.IRibbonControl, text Rs String) 
ActiveCell .Value = UCase (text) 

End Sub 

Public Sub UpdateText (control As Office.IRibbonControl, ByRef text) 
text = "Excel" 

End sub 


代码 分 析 : ContentChanged 函数 的 作用 是 ， 当 用 户 修 
改 文本 框 中 的 内 容 并 按 下 回 车 键 时 ， 活 动 单元 格 会 变 为 文 
本 框 内 容 的 大 写 形式 。 

UpdateText 函数 的 作用 是 ， 工 作 秒 一 打开 ,文本 框 里 


w | 
面 的 内 容 为 “Excel”。 : 
打开 该 工作 簿 ， 效 果 如 图 5-67 所 示 。 图 5-67 限制 输入 内 容 的 长 度 


5.4.10 onLoad 


onLoad 只 能 用 于 根 元 素 customUI， 其 作用 是 一 加 载 customUI 就 触发 VBA 中 onLoad 
对 应 的 回调 函数 ， 如 果 是 存储 于 工作 簿 中 的 customUI， 则 打开 工作 簿 时 触发 回调 函数 ， 
一 点 特别 类 似 于 Excel VBA 中 的 Workbook_Open 事件 。 

但 是 onLoad 更 大 的 作用 是 把 加 载 的 customUI 赋 给 一 个 Office.IRibbonUI 类 型 的 公有 变 
量 ， 之 后 可 以 方便 地 刷新 customUI 中 控件 的 状态 和 属性 等 。 

“实例 文档 25.xlsm” 中 的 XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="customUI Load"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="customTabA"” label=" 新 选项 卡 A"> 
</tab> 
<tab id="customTabB"” label=" 新 选项 卡 B"> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


上 述 XML 的 功能 是 创建 两 个 自 定义 选项 卡 ， 需 要 注意 的 是 ， 该 XML 中 包含 onLoad 回 
调 ， 因 此 在 VBA 中 创建 如 下 回调 函数 。 


Public Sub customUI Load (ribbon As office.IRibbonUI) 
ribbon.ActivateTab ControlID:="customTabB" 
End sub 


代码 分 析 : 括号 中 的 参数 ribbon As Office.IRibbonUI 就 是 指 整个 customUI。 
因此 ， 当 一 打开 工作 禾 ， 就 自动 运行 VBA 中 的 customUI Load 函数 ，ribbon ActivateTab 
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ControlID:="customTabB" 这 句 表示 激活 id 为 customTabB 的 自 定 义 选项 卡 ， 如 图 5-68 所 示 。 


日 5- -= 实例 文档 25xlsm - Excel 
到 手 入 二 人 学 数 生 击 风 视 申 开 避 T 上 HR 国 从 新 法 砚 FA | 新 光 员 F6 


图 5-68 加载 customUI 时 自动 激活 指定 的 选项 卡 


5.4.11 1IRibbonUl 对 象 


IRibbonUI 是 Office 对 象 库 下 面 的 成 员 ， 该 对 象 只 能 通过 customUI 的 onLoad 对 应 的 回 
调 函 数 返回 。 使 用 耻 ibbonUI 对 象 的 若干 方法 ， 可 以 在 customUI 加 载 之 后 反复 、 多 次 更 新 
控件 的 属性 。 

IRibbonUI 对 象 的 常用 方法 如 下 。 

口 ActivateTab: 激活 自 定义 选项 卡 。 

口 ActivateTabMso: 激活 内 置 选项 卡 。 

口 Invalidate: 刷新 customUI 的 所 有 元 素 (重新 运行 所 有 回调 函数 )。 

口 InvalidateControl: 只 刷新 指定 ControlID 的 元 素 。 

为 了 让 onLoad 回调 函数 返回 的 ribbon 能 够 被 多 次 访问 ,通常 把 ribbon 赋 给 模块 中 的 
public 类 型 变量 。 

“实例 文档 26.xlsm” 中 的 XML 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="customUI Load"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="customTabA"” label=" 新 选项 卡 A"> 
</tab> 
<tab id="customTabB"” label=" 新 选项 卡 B"> 
<group id="customGroupl" getLabel="Get Label"> 
<button id="customButtonl"” label=" 激活 新 选项 卡 A" size= 
"large" onAction="ActivateTabA" imageMso="DataRefreshAll"/> 
<button id="customButton2" label=" 激活 公式 选项 卡 " size= 
"large" onAction="ActivateTabFormulas" imageMso="DataRefreshAll"/> 
<button id="customButton3"” label=" 刷新 组 标签 文字 " size= 
"large" onAction="RefreshGroupCaption" imageMso="DataRefreshAll"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


该 XML 定义 了 两 个 自 定义 选项 卡 ， 其 中 第 二 个 自 定义 选项 卡 中 包含 一 个 组 ， 组 下 面包 
含 3 个 自 定义 按钮 。 需 要 注意 的 是 ， 该 XML 中 的 customUI 有 个 onLoad 回调 ， group 元 素 
使 用 了 getLabel 回调 。 
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VBA 中 的 代码 如 下 。 


Public R As Office.IRibbonUI 

Public Sub customUI Load (ribbon As office.IRibbonUI) 
Set R = ribbon 

End sub 

Public Sub ActivateTabA(control As Office.IRibbonControl) 
R.ActivateTab "customTabA" 

End Sub 

Public Sub ActivateTabFormulas (control As Office.IRibbonControl) 
R.ActivateTabMso "TabFormulas" 

End Sub 

Public Sub RefreshGroupCaption (Control As Office.IRibbonControl) 
R.InvalidateControl "customGroupl" 

End sub 

Public Sub Get Label (control As Office.IRibbonControl, ByRef label) 
label = Time 

End Sub 


代码 分 析 : 模块 中 共 包 含 5 个 函数 ，R 是 模块 中 的 公有 变量 ， 当 功能 区 一 加 载 就 把 整个 
功能 区 赋 给 变量 RR， 其 目的 是 可 以 让 R 在 其 他 过 程 中 也 能 发 挥 作用 。 

当 单 击 第 1 个 按钮 时 ， 激 活 自 定义 选项 卡 “ 新 选项 卡 A”; 当 单 击 第 2 个 按钮 时 ， 激 活 
“公式 ”内 置 选项 卡 ; 当 单 击 第 3 个 按钮 时 ， 刷 新 id 为 customGroupl 的 组 ,意味 着 要 重新 
运行 该 group 涉及 的 所 有 回调 函数 。 因 此 ， 每 当 单 击 第 3 个 按钮 ， 会 看 到 组 的 标签 显示 当前 
时 间 ， 如 图 5-69 所 示 。 
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图 5-69 动态 刷新 功能 区 


InvalidateControl 方法 更 新 指定 id 的 控件 ，Invalidate 方法 则 会 重新 运行 customUI 中 的 所 
有 回调 函数 。 因 此 ， 经 常 利用 这 个 技术 ， 实 现 通过 VBA 更 改 customUI 控件 的 属性 和 状态 。 
“实例 文档 27.xlsm” 中 的 XML 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="customUI Load"> 
<ribbon startFromScratch="false"> 
<tabs> 
<tab id="customTabA"” label=" 新 选项 卡 A" getVisible="Tab Visible"> 
</tab> 
<tab id="customTabB" label=" 新 选项 卡 B"> 
<group id="customGroupl"” label=" 动态 组 "> 
<button id="customButtonl"” label=" 按 钮 " getEnabled="Button_ 
Enabled"/> 
<checkBox id="customCheckl"” label=" 复 选 框 " getPressed= "Check 
Pressed"/> 
<labelControl id="customLabel" getLabel="Label Label"/> 
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</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


该 XML 中 涉及 的 重要 回调 有 : 新 选项 卡 A 的 getVisible 来 控制 该 选项 卡 是 否 显示 ， 按 
钮 的 getEnabled 属性 来 控制 按钮 是 否 可 用 ， 复 选 框 的 getPressed 属性 控制 该 复 选 框 是否 勾 
选 ， 标 签 控件 的 getLabel 控制 该 标签 显示 的 内 容 。 

对 应 的 VBA 回调 如 下 。 


Public R As office.IRibbonUI 

Public Sub customUI Load(ribbon As Office.IRibbonUI) 
Set R = ribbon 
R.ActivateTab "customTabB" 

End Sub 

Public Sub Tab Visible (control Rs Office.IRibbonControl, ByRef visible) 
visible = Sheetl.Range ("B1") .Value 


End Sub 

Public Sub Button Enabled(control As Office.IRibbonControl, ByRef enabled) 
enabled = Sheetl.Range("B2") .Value 

End Sub 

Public Sub Check Pressed(control As Office.IRibbonControl, ByRef returnValue) 
returnValue = Sheetl.Range("B3") .Value 

End Sub 

Public Sub Label Label (control As Office.IRibbonControl, ByRef label) 
label = Sheetl.Range("B4") .Value 

End Sub 


代码 分 析 : 可 以 看 出 ， 以 上 各 个 回调 函数 中 都 把 单元 格 的 内 容 传 递 回 去 ， 也 就 是 控件 的 
各 种 属性 取决 于 单元 格 的 值 。 
工作 表 上 的 “更 新 状态 ”按钮 对 应 的 VBA 过 程 如 下 。 


" 工作 表 按 钮 

Sub RefreshRll() 
R.Invalidate 

End Sub 


打开 该 工作 敌后 ， 更 改 单元 格 B1:B4 的 内 容 ， 然 后 单 击 “ 更 新 状态 ”按钮 ， 可 以 看 到 
功能 区 会 随 之 变化 ， 如 图 5-70 所 示 。 
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5-70 ”单元 格 的 数值 决定 功能 区 的 显示 状态 
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5.4.12 screentip-supertip-keytip 


screentip 、supertip 用 于 设置 控件 的 提示 语 ， 即 当 鼠 标 指针 悬浮 在 控件 上 方 时 弹出 的 提示 
信息 。 


下 面 的 XML 代码 设置 了 按钮 的 screentip 、supertip 属性 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 " keytip="A"> 
<group id="Groupl”1label=" 扩展 组 " keytip="B"> 


<button id="Buttonl"” label=" 提交 "” supertip=" 注意 : 一 旦 提交 不 
可 修改 ! " screentip=" 务必 确认 " keytip="C"/> 


</group> 
</tab> 
</tabs> 
</ribbon> a Ar 国 队 

</customUI> 提交 

当 鼠 标 指针 移动 到 按钮 时 ， 附 近 出 现 一 个 浮动 的 提示 框 , 如 图 | 
5-71 所 示 。 i = 

keytip 属性 用 来 指定 快捷 键 的 。 在 上 面 的 XML 中, tab、group、 | Romeo 5 
button 的 keytip 依次 设置 为 A、B、C， 那 就 意味 着 依次 按 下 键盘 上 | ”ae 


的 Alt、A、B、C， 可 以 快速 定位 到 上 述 各 元 素 。 图 5-71 设置 提示 语 
以 上 3 个 属性 对 应 的 动态 回调 属性 分 别 为 getScreentip 、getSupertip 、getKeytip。 


5.4.13 size 


size 属性 用 来 规定 控件 是 否 显示 为 大 ( large) 控件。 默认 情况 下 ， 每 列 可 以 垂直 放置 3 
个 控件 ， 如 果 设 置 为 large， 则 每 列 只 能 放 一 个 控件 。 

如 果 不 指定 size 属性 ， 则 默认 为 “normal”， 指 定 为 “large ”将 显示 为 大 控件 。 

在 下 面 的 XML 代码 中 ， 一 个 button 是 正常 尺寸 ， 另 一 个 button 显示 为 大 控件 。 


<button id="Buttonl"” label=" 中 国 " imageMso="SymbolInsert" size="normal"/> 
<button id="Button2"” label=" 中 华人 民 &g#xA; 共和 国 " imageMso="SymbolInsert" size="large"/> 


注意 &#ixA; 是 XML 语言 中 的 换行 符 ， 比 较 长 的 标题 文字 就 可 以 分 行 显示 ， 如 图 5-72 所 示 。 
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图 5-72 标题 在 指定 位 置换 行 
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与 size 属性 对 应 的 回调 属性 为 getSize 属性 。 
5.4.14 tag 


tag 属性 并 不 表现 在 控件 的 外 观 上 ， 通 常 利用 tag 属性 来 标识 不 同 的 控件 ， 或 者 让 控件 
存储 一 些 信息 ， 从 而 让 VBA 使 用 这 些 信息 。 
“实例 文档 24.xlsm” 中 的 XML 包含 3 个 自 定义 按钮 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="false"> 
<tabs> 
<tab id="Tabl" label=" 扩展 功能 "> 
<group id="Groupl"” label="tag 属性 "> 
<button id="Buttonl" label=" 记事 本 " tag="notepad.exe" onAction= 
"ShellAPP"/> 
<button id="Button2"” label=" 计算 器 " tag="calc.exe" onAction= 
"ShellApp"/> 
<button id="Button3"” label=" 画图 " tag="mspaint.exe" onAction= 
"ShellApp"/> 
</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


以 上 3 个 按钮 的 onAction 指向 同一 个 VBA 回调 函数 ,但 它们 的 tag 不 相同 。VBA 中 的 
回调 函数 如 下 。 


Public Sub ShellAPP(control As Office.IRibbonControl) 
Shell control.Tag, vbNormalFocus 
End Sub 


代码 分 析 : control.Tag 就 是 从 XML 中 获取 tag 属性 的 过 程 ， 例 如 单 击 了 “画图 ”按钮 , 
那么 相当 于 运行 了 Shell "mspaint.exe", VbNormalFocus。 
打开 该 工作 短 后 ， 单 击 任 一 按钮 ， 会 自动 启动 相应 的 应 用 程序 ， 如 图 5-73 所 示 。 
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图 5-73 ”多 个 控件 共用 同一 个 onAction 回调 函数 
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5.4.15 “小 结 回顾 


尽管 在 customUI 中 允许 放置 十 多 种 控件 ， 每 个 控件 有 诸多 属性 可 以 利用 ， 但 从 开发 实 
用 角度 讲 ， 只 要 掌握 如 下 9 种 控件 的 使 用 技术 就 已 经 足够 。 

6 个 基本 控件 : labelControl、button 、editBox 、toggleButton 、checkBox 和 dialogBoxLauncher。 

3 个 复杂 控件 : comboBox 、dropDown 、menu。 

“实例 文档 32.xlsm” 中 的 XML 代码 充分 展示 了 上 述 9 种 控件 的 用 法 技巧 ， 具 体 代 码 
如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="customUI onLoad"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl" label="customUI Demo"> 
<group id="Groupl"” label=" 简单 控件 "> 
<labelControl id="Labell"” label=" 标签 控件 "/> 
<button id="Buttonl"” label=" 按 钮 "imageMso="B" onAction= 
"Button OnAction"/> 
<editBox id="Editl"” label=" 文本 框 " getText="EditBox_getText" 
onChange="EditBox onChange"/> 
<toggleButton id="Togglel"” label=" 切换 按钮 "getPressed= 
"ToggleButton getPressed" onAction="toglleButton onAction"/> 
<checkBox id="Checkl"” label=" 复 选 框 " getPressed="CheckBox_ 
getPpressed" onAction="CheckBox onAction"/> 
<dialogBoxLauncher> 
<button id="Button2" onAction="ShowUserForm"/> 
</dialogBoxLauncher> 
</group> 
<group id="Group2”label=" 复杂 控件 "> 
<comboBox id="Combol"” label=" 组 合 框 " onChange="ComboBox 
onChange"> 
<item id="comboBox_iteml" label=" 子 项 1"/> 
<item id="comboBox_item2" label=" 子 项 2"/> 
<item id="comboBox item3" label=" 子 项 3"/> 
</comboBox> 
<dropDown id="dropDown1l"” label=" 下 拉 框 " onRction="dropDown 
onAction"> 
<item id="dropDown iteml" label=" 子 项 1"/> 
<item id="dropDown item2" label=" 子 项 2"/> 
<item id="dropDown item3" label=" 子 项 3"/> 
</dropDown> 
<menu id="Menul"” label=" 菜单 " imageMso="M"> 
<button id="menu buttonl"” label=" 子 项 1" onAction="Menu_ 
Button onAction"/> 
<button id="menu button2"” label=" 子 项 2" onAction="Menu_ 
Button onAction"/> 
<menuSeparator id="MenuSeparatorl"” title=" 分 隔 条 "/> 
<button id="menu button4"” label=" 子 项 4" onRction="Menu 
Button onAction"/> 
</menu> 
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</group> 
</tab> 
</tabs> 
</ribbon> 
</customUI> 


上 述 XML 代码 对 应 的 VBA 回调 函数 如 下 。 


"customUI 回调 函数 模块 

Public R As office.IRibbonUI 

Public Sub customUI_onLoad (ribbon As Office.IRibbonUI) 
Set R = ribbon 

End Sub 

Public Sub Button OnAction(control As Office.IRibbonControl) 
MsgBox control.ID 

End Sub 

Public Sub EditBox getText (control As Office.IRibbonControl, ByRef text) 
text = ActiveSheet.Name 

End Sub 

Public Sub EditBox onChange(control Rs Office.IRibbonControl, text Rs String) 
MsgBox text 


End Sub 
Public Sub ToggleButton getPressed(control Rs Office.IRibbonControl, ByRef 
returnValue) 
returnValue = True 
End Sub 


Public Sub toglleButton onAction(control As Office.IRibbonControl, pressed Rs 
Boolean) 
MsgBox pressed 


End Sub 
Public Sub CheckBox getPressed(control Rs Office.IRibbonControl, ByRef 
returnValue) 
returnValue = True 
End Sub 


Public Sub CheckBox onAction(control As Office.IRibbonControl, pressed As 
Boolean) 
MsgBox pressed 
End Sub 
Public Sub ShowUserForm(control As Office.IRibbonControl) 
UserForml .Show 
End Sub 
Public Sub ComboBox onChange (control As Office.IRibbonControl, text As String) 
MsgBox text 
End Sub 
Public Sub dropDown onAction(control As Office.IRibbonControl, selectedId As 
String, selectedIndex Rs Integer) 
MsgBox " 所 选 条 目的 ID: " & selectedId & vbNewLine & " 所 选 条 目的 序号 : " & selectedIndex 
End Sub 
Public Sub Menu Button onAction(control As Office.IRibbonControl) 
MsgBox control.ID 
End Sub 
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打开 该 工作 德 的 效果 如 图 5-74 所 示 。 
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图 5-74 最 常用 控件 的 应 用 展示 


5.4.16 customUl 的 XML 代码 编写 技巧 


进行 customUI 的 设计 开发 ， 能 和 否 快速 、 准 确 地 写 出 完整 、 有 效 的 XML 代码 是 整个 工 
作 的 瓶颈 。 编程 人 员 除 了 具备 XML 语言 的 通用 知识 ， 还 需要 了 解 专门 面向 Office customUI 


设计 的 XML 规范 。 


以 下 三 个 方面 是 进行 customUI 设计 经 常 遇 到 而 且 必 须 解 决 的 疑难 问题 。 


口 元 素 下 面 允 许 放置 哪些 子 元 素 ? 
口 元 素 可 以 使 用 哪些 属性 ? 
口 元 素 的 某 个 属性 可 以 取 哪 些 值 ? 


实际 上 ， 不 需要 死记 硬 背 每 个 控件 的 XML 写法 ， 可 以 借助 带 有 成 员 提示 的 XML 编辑 


器 (Office Ribbon Editor 或 Visual Studio 的 XML 编辑 器 ) 来 书写 。 


例如 ， 想 知道 buttonGroup 控件 下 面 允 许 放置 哪些 子 控件 ， 就 可 以 在 其 内 部 输入 左 尖 括 


[= 
Hy 


自动 弹出 可 选 菜单 ， 如 图 5-75 所 示 。 
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cuatomUILExcelaml” 所 
<customUI xmlns= “http: 
日 《ribbon startFromScratch=“false“> 
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3 <tabs> 

4 加 <tab id="Tabl” label=’custonUI Excel”» 

5 曲 “group id=“Groupl”label=“ 作 者 : 宝宝 > 
6 <buttonGroup> 

8 </buttonGroE lt-- 

9 </group> a 

10 </tab> 

11 </tabs> 

12 /ribbon> 


13 |</eustonUI> 


图 5-75 ”使 用 Visual Studio 的 XML 编辑 器 


不 允许 添加 的 控件 不 会 出 现在 菜单 中 。 
那么 ，menu 元 素 可 以 使 用 哪些 属性 呢 ? 
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输入 <menu> 后 ,在 单词 menu 后 面 按 一 下 空格 键 ， 就 自动 列 出 了 所 有 可 用 的 属性 ， 如 
图 5-76 所 示 。 


customUl Excelxmh - Microsoft Visual Studio (管理) 
六 HP。 坊 和 (F) 视 加 项 上 (P) 生 s(8) 调式 D) UM) XM IRM WHA() WN) BAW) WH) 


©-9| 旬 -各 昌 中 | -会 -| Wan -| 页- 


customUl Excelyml® 1 X 


1 日 customUI xmlns="http://schemas. microsoft. com/office/2009/07/customui”》 


2 9 《ribbon startFromScratch="false”> 
3 《tabs> 
4 晶 <tab id="Tabl”1label=“customUI Excel”> 
5 吨 《group id=”Group1”label=” 作 者 : 宝宝 > 
6ie <but tonGroup> 
7 二 menub 
8 四 5cn = 
9 /nenu 5 PET | =====met- 
10 </button(® oDescription 
££ getEnabled 
11 /group> | oemage 
12 /tab> [gris 
13 | </tabs> getlabel 
14 | /ribbon> ££ getScreertip 
15 |</ecustomUI> Pgetshowimage 


图 5-76 自动 弹出 可 用 的 属性 列表 


那么 ，enabled 属性 可 以 取 哪些 属性 值 呢 ? 
输入 <menu enabled=""， 可 以 看 到 只 能 取 菜单 中 的 4 个 值 ， 如 图 5-77 所 示 。 


二 somuLExeelxmi - Microsof Visual Studio (管理 列 
文件 (有 。 六 各 6 视图 (V) 。 项 目 (P) ”生成 B) 。 调 六 (D) 国人 (M) XMLO9 工具 0 9。 分析) 窗口 WV) 帮助 H) 


-9 各- 身 症 下 9- -| = -ma -| 击 - 
customULExcel xm PX 

1 日 <customUL xnlns="http://schemas. nicrosoft. com/office/2009/07/customui “> 

2 日 《ribbon startFromSeratch="false”> 

3 <tabs> 

4 <tab id="Tabl” label="customUl Excel”> 

5 5 《group id=“Groupl”1label=* 作 者 : 宝宝 "> 

615 buttonGroup> 

7 <menu enabled 二 37 

8 0 

9 </nonu> a EN 

10 /buttonGroup> we 

国 false 

11 《/group> 

12 </tab> 

13 | Ctabs> 


14 </ribbon> 
15 |</customUI> 
21% -| 


图 5-77 自动 弹出 属性 的 可 能 取 值 


5.5 使 用 Commandbars 对 象 操作 Office 内 置 控件 


Excel VBA 中 的 Application.Commandbars 提供 了 一 些 方法 ， 用 来 执行 或 读 取 内 置 控件 。 
口 ExecuteMso: 执行 内 置 控 件 命令 。 

口 GetEnabledMso: 获取 内 置 控件 的 可 用 性 。 

口 GetImageMso: 获取 内 置 控件 的 图 标 。 

口 GetLabelMso: 获取 内 置 控件 的 标题 文字 。 
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口 GetPressedMso: 获取 内 置 控件 的 按 下 状态 。 
口 GetSceentipMso: 获取 内 置 控 件 的 screentip。 
口 GetSupertipMso: 获取 内 置 控件 的 supertip。 
口 GetVisibleMso: 获取 内 置 控 件 的 可 见 性 。 


以 上 方法 的 参数 都 是 idMso 字符 串 。 


5.5.1 ”获取 内 置 控件 属性 


这 里 以 中 文 版 Excel 2013 的 “开始 ”选项 卡 的 “字体 ”组 的 “倾斜 ”按钮 为 例 ， 
OfficeidMsoViewer 软件 可 以 查 到 其 idMso 为 Italic， 如 图 5-78 所 示 。 


Excel_2013_tabs_en 
Excel_2013_tabs_jp 
PowerPoint_2013_backstage_cn 
PowerPoint_2013_backstage_en 
PowerPoint_2013_backstage_jp 
PowerPoint_2013_contextMenus_cn 
PowerPoint_2013_contextMenus_en 
PowerPoi 013_contextMenus_jp 
PowerPoint_2013_qat_cn 
PowerPoint_2013_qat_en 
PowerPoint_2013_qat_jp 
PowerPoint_2013_tabs_cn 
PowerPoint_2013_tabs_en 
PowerPoint_2013_tabs_ip 
PowerPoint_2013_tabSet_cn 
PowerPoint_2013_tabSet_en 
PowerPoint_2013_tabSet_jp 
Word_2013_backstage_cn 
Word_2013_backstage_en 
Word_2013_backstage_jp 
Word_2013_contextMenus_cn 
Word_2013_contextMenus_en 
Word_2013_contextMenus_ jp 
Word_2013_qat_cn 
Word_2013_qat_en 
Word_2013_qat_ 有 p 


EE RE 
ee idMso="TabHome”label=” 开 始 ”》 
由 -于 (group idMso=*GroupClipboard”1label=" 剪 贴 板 "> 
日- 贸 eroup idMso=“GroupFont”label=" 字 体 "> 
国 《comboBox idMso="Font”label=“ 字 体 :“> 
国 (comboBox idMso="FontSize”label=" 字 号 :“》 
人 FontSizeIncrease”label=" 增 大 字号 》 
FontSizeDecrease”label=” 减 小 字号 ">》 
本 “加 粗 “ 


eGallery”1abel= 下划线 "> 
入 | ctoggleButton idMso="Underline”label=" 下 划 线 "> 
已 - 国 menu> 
留 ctoggleButton idMso=“UnderlineDouble”1label="* 双 下 划 线 "> 
已 食 《splitButton idMso=“BordersGallery”label=" 边 框 》 
多 Coutton idMso="BorderBottomNoToggle”label=* 下 框 线 "> 
晶 - 鲁 ] menu> 
罚 <button idMso=”BorderTopNoToggle”label=" 上 框 线 "> 
轩 <button idMso="BorderLeftNoToggle”label=" 左 框 线 》 
重 ] button idMso="BorderRightNoToggle”label1=" 右 框 线 "> 


六 


通过 该 idMso 就 可 以 获得 该 控件 目前 的 状态 。 


Sub GetProperty() 
With Application 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
Debug. 
End With 
End sub 


Print 
Print 
Print 
Print 
Print 
Print 


.CommandBars 
"是 否 可 用 : "， 
"Label 是 : "， 
是否 被 接 下 E my 


.GetEnabledMso (idMso:="Italic") 
.GetLabelMso (idMso:="Italic") 
.GetPressedMso (idMso:="Italic") 
"SceenTip 是 : "， .GetScreentipMso (idMso:="Italic") 
"SuperTip 是: "， .GetSupertipMso (idMso:="Italic") 
"是否 可 见 : "， -GetVisibleMso (idMso:="Italic") 


当 单 击 非 斜体 的 单元 格 ， 如 图 5-79 所 示 。 


运行 上 述 VBA 过 程 ， 立 即 窗口 的 


行 结果 如 图 5-80 所 示 。 


如 果 单 击 有 斜体 内 容 的 单元 格 ， 再 次 运行 上 述 过 程 ， 结 果 是 不 一 样 的 。 


理论 上 讲 ， 使 用 以 上 6 


个 方法 ， 可 以 获知 Office 任何 一 个 内 置 控件 的 当前 属性 。 
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= 
EN 7 A ms sr 导 
Ms 宋体 加 
iim Tu- Eo-A 
| 字体 
B3 es 机 是 否 可 用 : True 
Label 是 : 倾斜 ?? 
人 2 是 否 被 技 下 : False 
| SceenTip 是 : 倾斜 2? 
引 EE 2 将 文字 变 为 斜体 * 
5 | 
图 5-79 和 鼠标 选中 非 斜体 的 单元 格 图 5-80 自动 获取 内 办 控件 的 状态 属性 


5.5.2 ”自动 执行 内 置 控件 的 命令 


如 果 事 先知 道 某 个 内 置 控 件 的 idadMso， 则 可 以 使 用 ExecuteMso 方法 自动 执行 该 控件 ， 
而 无 须 单 击 该 控件 。 
例如 ， 运 行 下 面 的 代码 ， 自 动弹 出 “页 面 设置 ” 对 话 框 。 


Sub AutoExec() 


Application.CommandBars.ExecuteMso ("PageSetupPageDialog") 
End Sub 


5.5.3 ”获取 内 置 控件 的 图 标 


getImageMso 方 法 会 返回 一 个 IPictureDisp 图 形 对 象 ， 该 对 象 可 以 赋 给 UserForm 的 
Image 控件 作为 图 像 。 
用 户 窗 体 上 放置 一 个 文本 框 、 一 个 按钮 、 一 个 image 控件 。 命 令 按钮 的 单 击 事件 如 下 。 


Private Sub CommandButtonl Click() 
Dim p Rs IPictureDisp 
Set p = Application.CommandBars.GetImageMso(idMso: = 
Me.TextBoxl.Text, Width:=32, Height:=32) 
Me.Imagel.Picture = p 
End Sub 


当 在 文本 框 输入 任意 一 个 idMso， 单 击 “ 显 示 ” 按 钮 ，Image 控 
件 就 显示 为 该 图 标 ， 如 图 5-81 所 示 。 


图 5-81 根据 内 置 控 
以 上 内 容 的 源 代码 文件 为 “实例 文档 29.xlsm”。 件 的 idMso 获取 图 标 


S$.6 上 自 定 义 快 速 访问 工具 栏 


自 定义 快速 访问 工具 栏 ， 需 要 在 ribbon 元 素 下 面 插入 qat 元 素 ， 如 果 customUI 中 包含 
qat 部 分 的 定制 ，ribbon 的 startFromScratch 属性 必须 设置 为 tue， 也 就 意味 着 会 隐藏 所 有 内 
置 选项 卡 。 


qat 元 素 下 面 是 sharedControls 元 素 ， 理 论 上 里 面 只 能 包含 button 、control 和 separator 


人 加 office VBA 开发 经 典 一 中 级 进 阶 郑 


三 种 控件 。 
下 面 的 XML 代码 在 快速 访问 工具 栏 中 放 和 内置 倾 斜 按钮 ， 放 和 人 一 个 分 隔 条 ， 再 放置 一 
个 自 定义 按钮 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromSscratch="true"> 


<qat> 
<sharedControls> 
<control idMso="Italic"/> 
<separator id="Separator1"/> 
<button id="Buttonl"” label=" 单 击 " onAction="Click" imageMso= 
"HappyFace"/> 
</sharedControls> 
</qat> EE 
</ribbon> EI 
</customUI> 
F6 | 
与 上 述 XML 对 应 的 Excel 界面 如 图 5-82 所 示 。 a & | 
如 果 要 向 快速 访问 工具 栏 中 放 入 group 等 复杂 控件 , 可 以 ”| 如 
结合 自 定义 常用 功能 区 ， 重 新 利用 <tabs> 元 素 下 面 的 控件 。 图 5-82” 自 定义 快速 访问 
“实例 文档 30.xlsm ”包含 如 下 XML 代码 。 工具 栏 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl"” label=" 扩展 功能 " visible="false"> 
<group id="Groupl"” label=" 自 定义 组 "> 
<button id="Buttonl"” label=" 按钮 " imageMso="D" onRction="OR"/> 


</group> 
</tab> 
</tabs> 
<qat> 
<sharedControls> 
<control idMso="Bold" imageMso="C"/> 
<control id="Button1l"/> 
<control idMso="GroupPageSetup"/> 
<control id="Groupl" imageMso="E"/> 
</sharedControls> 
</qat> 
</ribbon> 
</customUI> 


以 上 XML 代码 首先 创建 了 一 个 新 的 自 定义 选项 卡 ,但 是 隐藏 该 选项 卡 ， 然 后 在 <qat> 
的 部 分 重新 使 用 前 面 定 义 过 的 Buttonl 和 Group1。 


VBA 中 的 回调 函数 如 下 。 更 650 面 * 
EE "= 
Public Sub OA(control As Office.IRibbonControl) Ln3 | |i|x v 五 | 20:30:25 
ActiveCell .Value = Time i 一 一 一 & DE 
End Sub | | 
| B30:18 
a 
打开 工作 敌后 ， 单 击 最 后 一 个 按钮 ， 会 弹出 一 个 | 中 5 


group， 如 图 5-83 所 示 。 图 5-83 快速 访问 工具 栏 中 加 入 group 
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对 快速 访问 工具 栏 进行 自 定义 定制 ， 将 强迫 隐藏 掉 内 置 选 项 卡 ， 此 外 ,还 引起 Excel 的 
自 定义 功能 区 选项 对 话 框 无 效 。 这 些 都 给 用 户 带 来 了 很 大 不 便 ， 如 图 5-84 所 示 。 


De 罗 se 


人 FRO 二 OD EWEEE)O 
| 国 


图 5-84” 自 定义 快速 访问 工具 栏 造成 选项 空白 
因此 ， 在 实际 开发 过 程 中 ， 尽 量 避 免 对 快速 访问 工具 栏 进行 定制 。 


S.7 自 定 义 环境 功能 区 


在 正常 状态 下 ，Office 的 环境 功能 区 是 隐藏 的 ， 只 有 选择 了 具体 的 对 象 ， 在 常用 功能 区 
的 右 侧 显示 出 特定 的 功能 区 -Excel 2013 共有 十 多 个 内 置 的 环境 功能 区 ， 例 如 SmartArt 工具 、 
图 表 工 具 、 绘 图 工具 等 ， 使 用 OfficeidMsoViewer 软件 可 以 清晰 地 看 到 所 有 的 内 置 环境 功能 
区 及 其 内 部 包含 的 内 容 ， 如 图 5-85 所 示 。 


百 熏 contextualTabsy 
由 - 匀 ctabSet idMso=*TabSetSmarthrtTools”label=*Smarthrt 工具 "> 


由 -国人 tabSet idMso=”TabSetChartTools”label=" 图 表 工 具 ”> 
图 - 转 <tabSet idMso=”TabSetDrawingTools”label=“ 绘 图 工具 ”> 
日 鲁 《tabSet idMso="TabSetPictureTools”label=" 图 片 工 具 ”>》 
已 国人 tab idMso="TabpictureToolsFormat”label=" 格 式 "> 
让 - 记 ] ‘group idMso=“GrouppictureTools”1label=* 调 整 "> 
外 各 (eroup idMso=“GroupPictureStyles”label=" 图 片 样式 “> 
由 -于 ‘eroup idMso=“GroupArrange”label=“ 排 列 *> 
< 由 ?icture: nf 1]=" 大 省 


日 写 | 《splitButton idMso=“PictureCropTools”label=“ 修 饰 工具 “> 
司 ctoggleButton idMso=*PictureCrop”1label-“ 裁 竟 ^》 
外- 冬 人 menu> 
国 《control idMso=*ShapeHeight”1abel=* 高 度 :> 
国 《control idMso=*shapeWidth”label= “宽度 :> 
加 -外 dialogBoxLauncher> 
向- 国 | <tabSet idMso=”TabSetPivotTableTools”label=" 数 据 透 视 表 工具 “> 
田 - 筷 | ctabset idMso=”TabSetHeaderAndFooterTools”label=" 页 让 和 页 脚 工具 ”> 
由 -和 店 | <tabSet idMso-”TabSetTableToolsExcel”label-=" 表 格 工具 "> 
图 - 放 ] 《tabSet idMso=”TabSetPivotChartTools”label=" 数 据 透视 图 工具 ”》 


图 5-85 查看 内 置 环境 功能 区 
下 面 以 图 片 (是 Picture， 不 是 Drawing) 的 环境 功能 区 为 例 。 例 如 ,在 工作 表 上 选中 一 


人 辆 ”office VBA 开发 经 典 一 中 级 进 阶 卷 


个 图 片 ， 就 显示 出 环境 功能 区 “图 片 工 具 ” 这 个 tabSet， 可 以 看 到 其 中 包含 一 个 “格式 ”的 
tab， 如 图 5-86 所 示 。 


面 怠 护 ' 品 = 了 1- Eeeal IR 
一: EE 
a Fa Hem = -aH 
总 类 轿 训 ses | 瑟 刁 国 写 写 全 日 日 Si 
3 e: 更 FE 
图 片 2 "x vs "| 


a B c Dp E 5 6 下 下 证 
m 和 四 


Sheot! | Sheot2 | Shoo3 | 人 


图 5-86 Picture 对 象 的 环境 功能 区 


环境 功能 区 的 XML 结构 如 图 5-87 所 示 。 ee 
可 以 看 出 ， 从 tabSet 以 下 ， 与 以 前 讲 过 的 常用 功能 
区 的 架构 是 一 样 的 ， 也 是 tab 、group 、control 三 级 结构 。 = 
tabSet 使 用 idMso 属性 来 指明 是 哪 一 个 环境 功能 区 ， 不 能 A 
创建 用 户 自 定义 tabSet， 但 是 可 以 向 内 置 tabSet 下 面 添加 ee 
</customUI> 


自 定义 tab， 还 可 以 向 tab 中 添加 自 定义 group。 


5.7.1 创建 自 定义 选项 卡 
下 面 的 XML 代码 向 图 片 环境 功能 区 中 增加 一 个 自 定义 tab。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 


图 5-87 ”环境 功能 区 的 XML 结构 


<ribbon startFromscratch="false"> 
<contextualTabs> 
<tabSet idMso="TabSetPictureTools"> 
<tab id="Tabl" insertBeforeMso="TabPictureToolsFormat" label=" 
自 定义 "> 
</tab> 
</tabSet> 
</contextualTabs> 
</ribbon> 
</customUI> 


代码 分 析 : idMso="TabSetPictureTools" 指 的 是 图 片 环境 功能 区 ，insertBeforeMso= 
"TabPictureToolsFormat" 表示 在 “格式 ”选项 卡 左 侧 加 入 一 个 自 定义 选项 卡 。 
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Excel 中 ， 选 中 一 个 图 片 后 ， 可 以 看 到 多 出 来 一 个 空白 的 “ 自 定义 ”选项 卡 ， 如 图 5-88 
所 示 。 


1 下 
2 
3 
4 
5 
6 
7 
8 
9 - 


图 5-88 ”环境 功能 区 中 的 自 定义 选项 卡 
本 例 只 加 了 一 个 空白 的 tab， 读 者 可 以 根据 需要 往 里 面 添加 group 及 其 control。 


5.7.2 ”创建 自 定义 组 和 控件 


在 图 片 的 环境 功能 区 的 “格式 ”选项 卡 的 右 侧 可 以 看 到 一 个 名 为 “大 小 ”的 组 ， 里 面 可 
以 设置 所 选 图 片 的 高 度 和 宽度 。 

下 面 往 “ 大 小 ”组 左 侧 插入 一 个 “人 位置” 组， 用 来 设置 图 片 的 Top 和 Left 属性 ， 从 而 
达到 精确 定位 图 片 的 效果 。 

根据 O 多 ceidMsoViewer 软件 得 知 ， 该 组 的 引用 方式 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromScratch="false"> 
<contextualTabs> 
<tabSet idMso="TabSetPictureTools"> 
<tab idMso="TabPictureToolsFormat"> 
<group idMso="GroupPictureSize"/> 
</tab> 
</tabSet> 
</contextualTabs> 
</ribbon> 
</customUI> 


基于 上 述 代码 ， 修 改 为 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromSscratch="false"> 
<contextualTabs> 
<tabSet idMso="TabSetPictureTools"> 
<tab idMso="TabPictureToolsFormat"> 
<group id="Groupl" insertBeforeMso="GroupPictureSize" label= 
"位 置 "> 
<editBox id="Editl" label="Top" onChange="SetTop"/> 
<editBox id="Edit2" label="Left" onChange="SetLeft"/> 
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<button id="Buttonl” label=" 对 齐 到 单元 格 " onAction= "AlignCell" 
imageMso="PivotDropAreas"/> 
</group> 
</tab> 
</tabSet> 
</contextualTabs> 
</ribbon> 
</customUI> 


代码 分 析 : 上 述 XML 创建 了 一 个 “位 置 ”组 ， 添 加 两 个 文本 框 ， 用 来 设置 所 选 图 片 的 
Top 和 Left， 再 添加 一 个 “对 齐 到 单元 格 ” 按 钮 。 
上 述 XML 代码 保存 到 “实例 文档 34.xlsm” 中 , 在 其 VBA 模块 中 写 入 如 下 回调 。 


Public sr As Excel.ShapeRange, sp As Excel.Shape 
Public Sub SetTop (control Rs Office.IRibbonControl, text Rs String) 
Set sr = Application.Selection.ShapeRange 
For Each sp In sr 
sp.Top = CInt (text) 
Next sp 
End Sub 
Public Sub SetLeft (control Rs Office.IRibbonControl, text Rs String) 
Set sr = Application.Selection.ShapeRange 
For Each sp In sr 
sp.Left = CInt (text) 
Next sp 
End Sub 
Public Sub AlignCell(control As Office.IRibbonControl) 
Set sr = Application.Selection.ShapeRange 
For Each sp In sr 
sp.Left = sp.TopLeftCell.Left 
sp.Top = sp.TopLeftCell.Top 
Next sp 
End Sub 


打开 该 工作 每 ， 选 择 若 干 图 片 ， 在 Top 中 输入 一 个 数 并 按 下 回 车 键 ， 可 以 看 到 所 有 的 
图 片 均 顶 端 对 齐 到 同一 位 置 。 如 果 单 击 “ 对 齐 到 单元 格 ” 按 钮 ， 所 有 图 片 都 对 齐 到 所 属 单元 
格 的 左上 角 ， 如 图 5-89 所 示 。 


~ | mea Er | 


图 5-89 ”环境 功能 区 中 加 入 自 定义 组 和 控件 
以 上 就 是 自 定义 环境 功能 区 的 技术 要 点 。 
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S.8 自 定 义 右键 菜单 


Office 中 有 很 多 右键 菜单 ， 右 键 菜单 就 是 指 鼠 标 选 中 一 个 对 象 后 单 击 鼠 标 右键 弹出 的 菜 
单 。 单 击 的 对 象 不 同 ， 弹 出 的 菜单 内 容 也 不 同 。 

自 定义 右键 菜单 的 目的 ， 一 是 修改 右键 菜单 中 的 内 置 控 件 属性 ， 二 是 向 内 置 右键 菜单 中 
增加 用 户 自 定义 的 部 分 。 

自 定义 右键 菜单 的 XML 结构 如 图 5-90 所 示 。 


- <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
- <contextMenus> 
- <contextMenu> 
<control /> 
</contextMenu> 
</contextMenus> 
</customUI> 


图 5-90 “右键 菜单 的 XML 结构 


其 中 ， 每 一 个 <contextMenu> 元 素 都 代表 一 个 内 置 右键 菜单 。 要 对 内 置 的 右键 菜单 进行 
自 定义 ， 必 须 先 查询 到 该 菜单 的 idMso。 

本 节 以 Excel 的 图 形 右 键 菜单 为 例 ， 讲 解 一 下 如 何 对 Office 内 置 右键 菜单 进行 
customUI 设计 。 

图 形 右键 菜单 是 指 鼠 标 在 和 矩形、 文本 框 上 单 击 右键 出 现 的 菜单 ( 见 图 5-91 )。 注 意 : 并 
非 图 片 右键 菜单 。 


| 
14| 
15| 
16 | 
17| 
18| 号 于 于 放 忆 
19 
5 贸 起 站 本 由- 
21| 指 二 去 (N)-. 
| 设置 为 默认 形状 (D) 
| 向 大 If 时 人 四- 
25| SO) 
26| 
4 Sheet1 Sheet2 Sheet3 | 由 


图 5-91 Shape 对 象 的 右键 菜单 
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打开 OfficeidMsoViewer 软件 ， 左 侧 选 择 Excel 2013_contextMenus cn， 可 以 看 到 该 右 
键 菜单 的 idMso， 以 及 菜单 中 包含 的 各 项 的 idMso， 如 图 5-92 所 示 。 


Word_2013_tabSet_en 


Access_2013_tabs_en 
Access_2013_tabs_en 
Access_2013_tabSet_cn 
Access_2013_tabSet_en 
Access_2013_tabSet_jp 
Excel_3013 backstage_cn 
Excel 2013_backstage_en 


本 田力 


|Word_2013_tabSet_cn 有 全 <contextMenu idMso="ContextMenuPivotTableSimpleTouch” label=” 


Word-2013-tabSet— jp 图 - 久 ) <contextMenu idMso=“ContextMenupicture” label="”> 
Aceess_2013_backstage_en 日 - 罚 ceontextMenu idMso="ContextMenuShape” label=”">| 
Access_ 2013_backstage_en 辆 | button idMso="Cut”label=" 剪 切 ”>》 

J ea » 入 button idMso=“Copy”label-" 复 制 “> 
Access_2013_qat_en 重 | <gallery idMso=“PasteGalleryMini”label=" 粘 贴 选 项 ”> 


Access_2013_qat_jp 筷 ] button idMso=“0bjectAddText” 


label=“ 添 加 文字 “> 


Access_2013_tabs_jp 国 “toggleButton idMso="0bjectEditPoints 

7- 国 ] <menu idMso=“0bjects6roupMenu”label=" 组 合 ”> 

国 csplitButton idso=" "0bjectBringToRrontllen” label= " 团 于 顶层 ”> 
abt 


Excel 2013 backstage |j 


Excel_2013_contextMenus_en 
Excel_2013_contextMenus_ip 
Excel_2013 qat_cn 
Excel_2013_qat_en 
Excel_2013_qat_jp 


图 5-92 ”查找 内 置 右键 菜 单 的 XML 定义 
可 以 看 到 该 右键 菜单 的 idMso 为 ContextMenuShape， 其 中 ,“ 编 辑 文字 ”控件 是 一 个 


button， 它 的 idMso 为 ObjectEditText。 


5.8.1 修改 内 置 控件 状态 


知道 内 置 控件 idMso 的 前 提 下 ， 就 可 以 更 改 其 有 关 属 
性 ， 下 面 的 XML 代码 把 图 形 的 右键 菜单 里 的 “ 剪 切 ” 按 
钮 隐藏 ， 并 且 更 改 了 “编辑 文字 ”按钮 的 标题 文字 、 可 用 
性 和 图 标 。 


<customUI xmlns="http://schemas.microsoft. com/ 
office/2009/07/customui"> 
<contextMenus> 
<contextMenu idMso= "ContextMenuShape"> 
<button idMso="Cut" visible= "false"/> 
<button idMso="ObjectEditText" label= 
"文字 编辑 " enabled="false" imageMso="HappyFace"/> 
</contextMenu> 
</contextMenus> 
</customUI> 


图 形 右键 菜单 中 ,“ 剪 切 ” 按 钮 看 不 到 了 ， 而 且 “ 编 辑 
文字 ” 变 为 灰色 ,加 了 一 个 笑脸 图 标 ， 如 图 5-93 所 示 。 


5.8.2 ”添加 自 定义 控件 
在 ContextMenu 下 面 允 许 添加 的 控件 有 如 下 几 个 。 


4 A B C D | 
1 | 
mal > re] 
3 | | 
| 
| 
6 | 
| 
8 
| 
10| 
1 | 
12| 
13 
14 | 要 
人 [Se 
17| 指定 二 (N).。 
站 | 设置 为 上 形状 (D) 
20 | 3 大 小 和 尾 性 加- 
21| YR). 
22 
图 5-93 ”修改 右键 菜单 中 内 站 
控件 的 属性 
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口 button 

口 checkBox 

口 dynamicMenu 

口 control 

口 gallery 

口 menu 

口 menuSeparator 

口 splitButton 

口 toggleButton 

“实例 文档 33.xlsm” 包 含 的 XML 代码 向 Excel 图 形 右键 菜单 中 加 入 一 个 button 和 一 个 
toggleButton 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<contextMenus> 
<contextMenu idMso="ContextMenuShape"> 
<button id="Buttonl"” insertRfterMso="Cut"” label=" 隐藏 形状 " onAction= 
"HideShape" imageMso="InsertTag"/> 
<toggleButton id="Togglel"” label=" 锁定 纵横 比 " onAction="LockAspectRatio" 
imageMso="Lock"/> 
</contextMenu> 
</contextMenus> 
</customUI> 


打开 该 工作 夭 ， 在 图 形 上 右 击 ， 在 弹出 的 菜单 中 可 以 看 到 剪 切 按钮 的 下 面 多 了 一 个 “ 隐 
藏 形状 ”按钮 ， 同 时 该 菜单 的 最 底 端 多 了 一 个 “锁定 纵横 比 ”切换 按钮 ， 如 图 5-94 所 示 。 


多 ii 


a 指定 宏 (N)-. 
22| 设置 为 默认 形状 (D) 
| 向 大 小 和 居 性 四 .… 
全 | 创设 村 形状 格 S(O)- 
26 | 合 ”锁定 纵横 比 
和 0 本 作 Sheet1 | Sheet2 | Sheet3 | 由 


5-94 右键 菜单 中 加 入 自 定义 控件 
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这 两 个 控件 的 回调 函数 如 下 。 


Public Sub HideShape (Control As Office.IRibbonControl) 
Dim sp As Shape 
Set sp = Application.Selection.ShapeRange (1) 
sp.Visible = msoFalse 
End sub 
Public Sub LockAspectRatio(control As Office.IRibbonControl, pressed Rs Boolean) 
Dim sp As Shape 
Set sp = Application.Selection.ShapeRange (1) 
sp.LockAspectRatio = Not sp.LockAspectRatio 
End Sub 


5.9” 自 定义 Office 菜单 


在 Office 2010 以 上 版 本 中 ，Office 按钮 由 “文件 ”选项 卡 替 代 。 通 过 单 击 “文件 ”选项 
卡 ， 可 进入 backstage 视图 。 

与 常用 功能 区 相 比 ，backstage 的 界面 定制 更 加 灵活 ， 元 素 更 加 丰富 ， 但 是 理解 难度 也 
相应 增 大 。 

开发 人 员 可 以 对 backstage 视图 进行 完全 扩展 ， 从 而 允许 组 织 自 定义 用 户 界面 以 满足 需 
求 。 和 开发 其 他 场所 一 样 ， 用 户 既 可 以 修改 backstage 视图 中 的 内 置 控 件 ， 也 可 以 从 头 创建 
用 户 自己 的 元 素 。 


5.9.1 自 定 义 backstage 视图 概述 


backstage 视图 主要 由 选项 卡 (tab) 和 按钮 (button) 构成 ， 光 从 外 观 上 看 不 出 tab 和 
button 的 不 同 之 处 。 例 如 ，Excel 2013 的 backstage 视图 中 ,“ 保 存 "“ 关 闭 ” 和 “选项 ”这 三 
个 是 按钮 ， 而 “信息 ”等 是 选项 卡 ， 如 图 5-95 所 示 。 


Feel 


电子 邮件 
和 个 人 R14 同 


人 
二 


和 个 人才 使 用 此 工作 等 从 全 


[=] RE 
intonet EERE 
Es 


图 5-95 backstage 视图 
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单 击 一 个 按钮 ， 通 常会 弹出 一 个 对 话 框 或 者 执行 一 个 命令 ， 但 是 单 击 一 个 选项 卡 ， 会 在 
右 侧 出 现 相应 的 组 和 控件 。 
Excel 2013 的 backstage 视图 中 一 部 分 内 置 选项 卡 和 按钮 信息 如 表 5-3 所 示 。 


表 5-3 Excel 2013 的 backstage 视图 中 部 分 选项 卡 和 按钮 信息 


idMso 类 型 
TabInfo tab 
TabNew tab 
FileSave button 
TabSave tab 
TabPrint tab 
TabShare tab 
TabPublish tab 
FileClose button 
ApplicationOptionsDialog button 
知道 内 置 控 件 的 idMso 后 ， 就 可 以 更 改 内 置 控件 的 
属性 ， 或 者 添加 用 户 自 定 义 控 件 。 
例如 ， 下 面 的 XML 代码 对 Excel 2013 的 backstage 
进行 了 4 处 自 定义 
<customUI xmlns="http://schemas .microsoft.com/ 
office/2009/07/customui"> 
<backstage> 
<button idMso="FileSave" label="Save" 
imageMso="FileSave"/> 
<tab idMso="TabShare"” label=" 分享 " 
insertBeforeMso="TabNew"> 
</tab> 
<button id="Buttonl"” label=" 按钮 "/> 
<tab id="Tabl”label=" 选项 卡 "> 
</tab> 
</backstage> 
</customUI> 
修改 内 置 “保存 ”按钮 的 标题 为 “Save"， 修 改 内 
置 选项 卡 “共享 ”为 “分 享 ”， 加 入 一 个 新 button， 再 
加 入 一 个 新 tab， 并 且 把 新 选项 卡 置 于 信息 选项 卡 之 上 ， 
如 图 5-96 所 示 。 图 5-96 ” 自 定 义 backstage 主 菜单 
5.9.2 backstage 的 XML 架构 
自 定义 backstage 的 重点 和 难点 是 向 自 定义 tab 中 添加 元 素 。 与 定制 常用 功能 区 有 所 不 


同 ，backstage 中 的 tab 下 面 只 能 是 frstColumn 或 secondColumn ， 分 别 表示 第 1 列 和 第 2 列 。 
firstColumn 下 面 可 以 是 group 、taskGroup 或 taskFormGroup 三 者 之 一 。 这 三 个 分 别 表示 
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不 同 的 布局 风格 。 
用 于 自 定义 backstage 的 典型 XML 结构 如 图 5-97 所 示 。 


- <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
=- <backstage> 
<button /> 
- <tab> 
- <firstColumn> 
- <group> 
<topItems /> 
</group> 
</firstColumn> 
</tab> 
</backstage> 
</customUI> 


图 5-97 自 定义 backstage 的 XML 结构 


5.9.3 group 风格 


tab 的 下 一 级 是 firstColumn 或 secondColumn，firstColumn 的 下 一 级 可 以 是 group、 
taskGroup 或 taskFormGroup。 

group 的 下 一 级 可 以 是 bottomItems 、primaryItem 、topItems 三 者 之 一 。 

primaryItem 下 面 只 能 放置 button 或 menu 控件 ，topItems 下 面 则 可 以 放置 很 多 种 类 型 的 
控件 ， 也 可 以 放置 布局 容器 (layoutContainer ) 。 

“实例 文档 37.xlsm” 中 的 XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<backstage> 
<tab id="Tabl" label="group Style" insertBeforeMso="TabShare" columnWidth 
Percent="40"> 
<firstColumn> 
<group id="Groupl" label="SendMail" helperText="fill in these 
fields please."> 
<primaryItem> 
<button id="Button2" label="Send Mail" onAction="OA" 
imageMso="MicrosoftOutlook"/> 
</primaryItem> 
</group> 
<group id="Group2" label="Detail"> 
<topItems> 
<labelControl id="Labell" label="you must fill in these 
fields before send mail"/> 
<layoutContainer id="Layoutl" layoutChildren="horizontal"™" 
expand="neither"> 
<editBox id="Editl" label="To:"/> 
<editBox id="Edit2" label="Cc:"/> 
</layoutContainer> 
<layoutContainer id="Layout2" layoutCchildren="vertical™" 


expand="neither"> 
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<editBox id="Edit3" label="Subject:"/> 
<editBox id="Edit4" label="Body:"/> 
</layoutContainer> 
</topItems> 
</group> 
</firstColumn> 
</tab> 
</backstage> 
</customUI> 


代码 分 析 : 上 述 XML 代码 创建 了 一 个 新 的 选项 卡 “ group style”"， 在 其 第 1 列 中 放置 了 
两 个 group， 分 别 使 用 了 primaryItem 和 topItems。 

需要 注意 的 是 ，topItems 中 包含 一 个 labelControl 和 4 个 editBox， 其 中 ，To 和 Cc 这 两 
个 文本 框 放置 于 一 个 水 平 排列 的 布局 容器 中 ，Subject 和 Body 文本 框 一 起 放置 于 一 个 垂直 方 
向 的 容器 中 ， 如 图 5-98 所 示 。 


oa SendMail 
fill in these fields please. 


Send Mail 


Detail 


you must fill in these fields before send mail 
To: Cc: 水 平 排列 
Subject: 


Body: 


图 5-98 ”group 风格 的 backstage 设计 


根据 需要 ， 还 可 以 为 tab 增加 secondColumn， 这 将 显示 于 frstColumn 的 右 侧 。 例 如 在 
上 述 XML 代码 的 frstColumn 节点 之 后 增加 如 下 代码 。 


<secondColumn> 
<group id="Group3" label="ReceiveMail" helperText="click it will receive mails."> 
<primaryItem> 
<button id="Button3" label="Receive Mail" onAction="OA" imageMso= 
"MicrosoftOutlook"/> 
</primaryItem> 
</group> 
</secondColumn> 


在 Excel 的 backstage 视图 中 可 以 看 到 新 选项 卡 中 多 了 一 列 ， 如 图 5-99 所 示 。 
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secondColumn 
ReceiveMail 


SendMail 


Send Mail 


Detail 
you must ll in these fields before send mail 
To: ce 
的 Subject 
打印 Body: 


group Se 


图 5-99 增加 secondColumn 


5.9.4 taskGroup 风格 


taskGroup 与 group 不 同 ， 下 面 的 元 素 依次 是 category 和 task。 一 个 taskGroup 下 面 可 以 
有 一 个 以 上 的 category， 一 个 category 以 下 可 以 有 多 个 task。 

task 和 以 前 学 过 的 button 控件 的 用 法 一 样 ， 其 中 isDefinitive 属性 比较 重要 ， 如 果 设 置 
为 tue， 表 示 鼠 标 单 击 该 task， 会 自动 退出 backstage 视图 ， 回 到 Excel 工作 表 界 面 ; 设置 为 
false， 则 还 停留 在 backstage 视图 。 

“实例 文档 38.xlsm” 中 的 XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<backstage> 
<tab id="Tabl" label="taskGroup Style" insertBeforeMso="TabShare" 
columnWidthPercent="40"> 
<firstColumn> 
<taskGroup id="TaskGroupl"” label=" 东北 地 区 "> 
<category id="Categoryl"” label=" 黑龙 江 省 "> 
<task id="Taskl"label=" 哈尔滨 " isDefinitive="true" 
onAction="OA" imageMso="A"/> 
<task id="Task2"” label=" 佳木斯 " isDefinitive="true" 
onAction="OA" imageMso="B"/> 
<task id="Task3" label=" 大庆" isDefinitive="false" 
onAction="OA" imageMso="C"/> 
</category> 
<category id="Category2"” label=" 吉林 省 "> 
<task id="Task4" label=" 长 春 " isDefinitive="true" 


onAction="OA" imageMso="D"/> 
<task id="Task5" label=" 四 平 " isDefinitive="true" 

onAction="OA" imageMso="E"/> 
<task id="Task6"” label=" 延 边 " isDefinitive="false" 

onAction="OA" imageMso="F"/> 

</category> 
</taskGroup> 
</firstColumn> 
</tab> 
</backstage> 
</customUI> 
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当 单 击 “ 哈 尔 滨 ” 或 “佳木斯 ”时 ， 会 自动 返回 到 工作 表 界 面 ， 而 单 击 “大 庆 ” 不 自动 
返回 ， 如 图 5-100 所 示 。 


图 5-100 taskGroup 风格 


5.9.5 taskFormGroup 风格 


taskFormGroup 风格 与 taskGroup 风格 最 为 相似 ， 不 同 的 是 ，taskGroup 风格 下 面 的 末梢 
元 素 task 相当 于 button 的 功能 ， 不 能 继续 展开 。 而 taskFormGroup 中 的 task 元 素 下 面 可 以 
继续 以 group 为 子 元 素 ， 一 个 task 下 面 可 以 包含 多 个 group。 因 此 ， 使 用 taskFromGroup 可 
以 实现 级 联 式 的 组 织 结构 。 例 如 ，Outlook 的 邮件 列表 就 是 这 种 机 制 ， 单 击 不 同 的 邮件 标题 ， 
右 侧 出 现 相应 的 邮件 详情 。 

“实例 文档 39.xlsm” 中 的 customUI 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<backstage> 
<tab id="Tabl"” label=" 我 的 简历 " insertBeforeMso="Tabshare" columnWidth 
Percent="40"> 
<firstColumn> 
<taskFormGroup id="TaskFormGroupl"” label=" 简历 中 心 " allowedTask 
Sizes="largeMediumSmall" helperText=" 简历 中 心 "> 
<category id="Categoryl” label=" 基本 信息 "> 
<task id="Taskl”label=" 个 人 信息 "> 
<group id="Groupl” label=" 个 人 信息 "> 
<topItems> 
<layoutContainer id="Layout0" layoutChildren= 
"vertical" expand="neither"> 
<imageControl id-"Imagel" getImage="getPhoto"/> 
<editBox id="Editl" label=" 姓 名"/> 
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<editBox id="Edit2" label=" 年 龄 "/> 
</layoutContainer> 
</topItems> 
</group> 
</task> 
<task id="Task2” label=" 联系 方式 "> 
<group id="Group2”label=" 联系 方式 "> 
<topItems> 


<editBox id="Edit3" label=" 手 机"/> 
<editBox id="Edit4"” label=" 邮箱 "/> 
</topItems> 
</group> 
</task> 
</category> 


<category id="Category2”label=" 教育 经 历 "> 
<task id="Task3"” label=" 本 科 "> 
<group id="Group3"” label=" 本 科 "> 
<topItems> 
<editBox id="Edit5"” label=" 院 校 "/> 
<editBox id="Edit6"” label=" 专业"/> 
</topItems> 
</group> 
</task> 
<task id="Task4"” label=" 硕士 "> 
<group id="Group4"” label=" 硕士 "> 
<topItems> 
<editBox id="Edit7"” label=" 院 校 "/> 
<editBox id="Edit8"” label=" 专业 "/> 
</topItems> 
</group> 
</task> 
<task id="Task5"” label=" 博士 "> 
<group id="Group5"” label=" 博士 "> 
<topItems> 
<editBox id="Edit9"” label=" 院 校 "/> 
<editBox id="Edit10"” label=" 专业 "/> 
</topItems> 
</group> 
</task> 
</category> 
<category id="Category3"” label=" 外 语 水 平 "> 
<task id="Task6" label=" 英语 "> 
<group id="Group6"” label=" 英语 "> 
<topItems> 
<labelControl id-"Label1l”1label=" 大 学 英语 六 级 "/> 
<labelControl id="Label2"” label=" 听 说 读 写 能 
力 比较 强 "/> 
</topItems> 
</group> 
</task> 
<task id="Task7"” label=" 日 语 "> 
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<group id="Group7" label-" 日 语 "> 
<topItems> 
<checkBox id-"Checkl”1label-" 具有 多 年 留学 经 验 "/> 
<checkBox id="Check2"” label=" 具有 国外 工作 经 验 "/> 
</topItems> 
</group> 
</task> 
</category> 
<category id="Category4” label=" 编程 语言 "> 
<task id="Task8" label="VBA"> 
<group id="Group8" label="VBA"> 
<topItems> 
<layoutContainer id="Layoutl" layoutChildren= 
"horizontal" expand="neither"> 
<checkBox id="Check3" label="Excel"/> 
<checkBox id="Check4" label="PowerPoint"/> 
<checkBox id="Check5" label="Word"/> 
<checkBox id="Check6" label="Access"/> 
<checkBox id="Check7" label="Outlook"/> 
</layoutContainer> 
</topItems> 
</group> 
</task> 
<task id="Task9" label="Python"> 
<group id="Group9" label="Python"> 
<topItems> 
<layoutContainer id="Layout2" layoutChildren= 


"vertical"> 
<hyperlink id="Hyperl"” label=" 菜鸟 教程 " 
target="http://www.runoob.com/python3/python3-tutorial .html"/> 
</layoutContainer> 
<dropDown id="Dropl" alignLabel="center" 
expand="neither"> 
<item id="Iteml"” label=" 基础 语法 "/> 
<item id="Item2"” label=" 序列 对 象 "/> 
<item id="Item3" label=" 选择 循环 "/> 
<item id="Item4" label=" 文件 读 写 "/> 
</dropDown> 
</topItems> 
</group> 
</task> 
</category> 
</taskFormGroup> 
</firstColumn> 
</tab> 
</backstage> 
</customUI> 


代码 分 析 : XML 代码 虽然 看 起 来 很 长 ,但 是 都 遵循 taskFormGroup/category/task/group 
的 四 级 结构 ， 当 用 鼠标 单 击 不 同 的 task， 右 侧 会 跳 转 到 相应 的 group 中 ， 如 图 5-101 所 示 。 
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图 5-101 taskFormGroup 风格 


5.9.6 ”重要 属性 解释 
在 backstage 的 customUI 设计 过 程 中 会 遇 到 一 些 前 面 未 出 现 过 的 属性 名 和 属性 值 ， 如 
表 5-4 所 示 。 
表 5-4 backstage 设计 中 用 到 的 常用 属性 


元 素 含义 或 可 取 值 
backstage 当 显示 、 关 闭 backstage 视图 时 触发 的 回调 过 程 


三 RE 100 以 下 的 整数 ， 表 示 firstColumn 所 占 的 百分比 ， 假 如 是 30 
则 表示 firstColumn 和 SecondColumn 宽度 之 比 是 3:7 


os Wi 


group style 或 getStyle 取 值 为 normal、error、warning， 规 定 一 个 组 的 显示 风格 

layoutContainer | layoutChildren 取 值 为 horizontal 、vertical， 规 定 容器 中 各 个 控件 的 排列 方向 

ee 取 值 为 liensl 、vVertical 、both、neighbor， 规 定 容 器 中 控件 
的 扩展 方向 

taskFormGroup | allowedTaskSizes 枚 举 值 ， 规 定 是 否 可 以 调整 task 的 尺寸 

task description task 的 描述 信息 


imageControl image、imageMso、getImage | 显示 一 个 图 片 的 控件 


hyperlink 显示 一 个 指定 url 的 超 链接 

在 实际 开发 过 程 中 ,结合 实际 项 目 ， 对 以 上 属性 进行 微调 即 可 。 

“实例 文档 40.xlsm ”演示 了 一 个 自动 更 改 图 片 的 功能 ,每 当 重 新 进入 backstage 视图 ， 
看 到 的 图 片 是 不 一 样 的。 其 中 的 XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui™" 
onLoad="OnLoad"> 
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<backstage onShow="OnShow" onHide="OnHide"> 
<tab id="Tabl"” label=" 自动 换 图 "insertBeforeMso="TabShare" columnWidthPercent= 
60"> 
<firstColumn> 
<group id="Groupl"” label=" 警告 " style="warning"> 
<topItems> 

<layoutContainer id="Layoutl" layoutChildren="vertical™" 

expand="vertical"> 


<imageControl id="Imagel" getImage="GetImage"/> 
<editBox id="Editl" label=" 图 片 名 称 " getText= 


"GetName"/> 
<editBox id="Edit2" label=" 符号 序列 " getText= 
"GetSymbol"/> 
</layoutContainer> 
</topItems> 
</group> 
</firstColumn> 
</tab> 
</backstage> 
</customUI> 


与 上 述 XML 代码 对 应 的 VBA 回调 函数 如 下 。 


"customUI 回调 函数 模块 
Public R As IRibbonUI, i As Integer 


Sub OnShow (contextObject As Object) 
i=i+1l 
R.Invalidate 

End Sub 

Sub OnHide (contextObject As Object) 


End Sub 


Public Sub OnLoad (ribbon As office.IRibbonUI) 
Set R = ribbon 
=0 

End Sub 

Public Sub GetImage (control As Office.IRibbonControl, ByRef image) 
Set image = LoadPicture (ThisWorkbook.Path & "\ 扑克 牌 \" & i & ".jpg") 

End Sub 

Public Sub GetName (Control As Office.IRibbonControl, ByRef text) 
text = 1 &€ “DG 

End Sub 

Public Sub GetSymbol (control As Office.IRibbonControl, ByRef text) 
text = String(i, "®") 

End Sub 


代码 分 析 : 使 用 了 backstage 的 OnShow 回调 ， 这 个 与 OnLoad 回调 不 同 ，OnLoad 回调 
打开 工作 敌后 只 发 生 一 次 ， 而 OnShow 是 每 当 重 新 打开 backstage 视图 都 会 触发 。 

另外 ， 本 例 中 group 的 style 为 warning， 那 么 该 组 显示 的 外 观 为 浅 红色 ， 如 图 5-102 
所 示 ， 读 者 可 自行 尝试 。 
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图 5-102 利用 OnShow、OnHide 回调 函数 动态 更 新 界面 


S.10 ”更改 内 置 控 件 属性 


customUI 除了 可 以 定制 前 面 所 述 的 $ 个 场所 ， 还 可 以 使 用 commands 重 定义 内 置 控 件 。 


commands 元 素 节 点 中 允许 放 多 个 command， 每 个 command 节点 重新 定义 一 个 控件 的 


允许 重新 定义 的 
的 功能 。 
下 面 的 XML 代码 禁用 “保存 ”功能 以 及 “加 粗 ” 按 钮 。 


属性 主要 有 enabled 和 onAction， 也 就 是 更 改 内 置 控件 的 可 用 性 和 控件 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<commands> 
<command idMso="FileSave" enabled="false"/> 
<command idMso="Bold" enabled="false"/> 
</commands> 
</customUI> 


可 以 看 到 Excel 的 保存 、 加 粗 都 是 灰色 不 可 用 的 ， 如 图 5-103 所 示 。 
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图 5-103 ”利用 commands 更 改 内 置 控件 的 属性 
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S.11 customUI 疑难 解答 


问 : 能 不 能 隐藏 内 置 组 中 的 控件 ?能 不 能 任意 修改 内 置 组 中 控件 的 label 或 者 其 他 
属性 ? 

答 : 不 能 任意 修改 内 置 组 中 控件 的 属性 。 

问 : 向 Office 文档 中 压 和 人 XML 代码 的 技术 很 重要 吗 ? 

答 : Office 文档 的 安全 性 比较 低 ， 容 易 被 破解 ， 因 此 向 Office 文档 中 压 和 人 XML， 意味 
着 回调 函数 必须 写 在 文档 的 VBA 工程 中 ,分 发 给 他 人 后 ， 就 等 于 公开 文档 的 一 切 。 因 此 ， 
XML 如 何 压 人 Office 文档 了 解 一 下 即 可 。 

问 : customUI 呈现 出 的 界面 ， 只 有 包含 该 代码 的 文档 处 于 活动 文档 才 显 示 界 面 ， 怎 样 
变 成 全 局 的 、 不 受 文档 切换 的 应 用 程序 级 的 customUI 呢 ? 

答 : 对 于 Excel， 首 先 把 XML 压 和 到 工作 短文 件 中 ,然后 把 该 工作 短 另 存 为 Excel 加 载 
宏 (扩展 名 为 xlam)， 加 载 安 中 的 customUI 是 全 局 性 的 ， 不 随 工作 短 窗 口 的 切换 而 改变 。 

对 于 Word， 可 以 把 文档 另存 为 扩展 名 为 .dotm 的 模板 文件 。 

对 于 PowerPoint， 把 演示 文稿 另存 为 扩展 名 为 .ppam 的 加 载 宏 文件 。 

问 : 顺利 进行 customUI 开发 ， 具 体 需 要 安装 哪些 工具 和 软件 ? 

答 : 主要 工具 选择 Ribbon XML Editor 或 CustomUI Editor 之 一 ，idMso 查询 工具 选择 
OfficeidMsoViewer，imageMso 查询 工具 选择 ImageMso7345.xlsm。 

对 customUI 的 XML 语法 和 成 员 不 太 熟 悉 的 读者 ， 还 可 以 在 Visual Studio 中 快速 编辑 
XML。 

问 : 能 否 在 同一 个 文档 的 customUI 代码 中 同时 包含 自 定义 多 个 场所 ? 

答 : 可 以 。 本 书 中 的 实例 一 般 一 个 工作 簿 中 只 定义 一 个 场所 ,实际 上 根据 需要 可 以 同时 
定制 多 个 场所 。 

例如 “实例 文档 35.xlsm” 中 的 XML 代码 如 下 。 


<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
<ribbon startFromscratch="true"> 
<tabs> 
<tab id="Tabl" label=" 常用 选项 卡 "/> 
</tabs> 
<qat> 
<sharedControls> 
<button id="Buttonl"” label=" 按钮 " imageMso="Q"/> 
</sharedControls> 
</qat> 
<contextualTabs> 
<tabSet idMso="TabSetSmartArtTools"> 
<tab idMso="TabSmartArtToolsDesign"” label=" 我 的 设计 "/> 
</tabSet> 
</contextualTabs> 
</ribbon> 
<backstage> 
<button id="Button2"” label-" 按钮 "/> 
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</backstage> 
<contextMenus> 
<contextMenu idMso="ContextMenuWorkbookPly"> 
<button idMso="SheetInsertPage” label=" 插入 工作 表 "/> 
</contextMenu> 
</contextMenus> 
</customUI> 


以 上 customUI 代码 同时 定制 了 常用 功能 区 、 人 快速 访 问 工 具 栏 、 环 境 功 能 区 、 碳 键 菜单 、 
Office 菜单 5 个 场所 。 

问 : Office 2007 的 customUI 定制 有 哪些 注意 事项 ? 

答 : 一 定 要 考虑 customUI 命名 空间 的 影响 ， 如 果 文 档 要 在 Office 2007 中 打开 ,那么 
该 文档 中 customUI 的 命名 空间 必须 是 : <customUI xmlns="http://schemas.microsoft.com/ 
office/2006/01/customui">， 否 则 自 定 义 界面 无 法 显示 。 

如 果 文 档 要 在 Office 2010 及 其 以 上 版 本 中 打开 ,命名 空间 最 好 是 <customUI 
xmlns="http://schemas.microsoft.com/office/2009/07/customui">， 当 然 也 可 以 是 <customUI 
xmlns="http://schemas.microsoft.com/office/2006/01/customui">, 

实际 上 , 一 个 Offce 文档 可 以 同时 压 和 人 两 份 不 同 的 XML 代码 ， 从 而 达到 在 O 欠 ce 2007 
中 打开 和 在 Office 2010 中 打开 呈现 不 同 的 界面 。 

“实例 文档 36.xlsm” 中 包含 了 2007 和 2010 两 部 分 的 customUI， 在 不 同 版 本 的 Office 
中 打开 后 效果 不 一 样 。 


5.12 “本章 小结 


使 用 customUI 技 术 ， 可 以 在 Office 的 很 多 场所 添加 用 户 自 定义 的 界面 元 素 ， 也 可 以 修 
改 Office 内 置 元 素 。 

对 于 常用 功能 区 ，tab 、group 、button 以 及 其 他 控件 形成 了 三 级 XML 结构 。 

button 是 最 常用 的 元 素 ， 常 用 属性 有 label 和 onAction 。 

对 于 customUI 中 出 现 的 元 素 ， 如 果 引 用 的 是 内 置 元 素 ， 需 要 指定 idMso 属性 ， 如 果 是 
自 定义 元 素 ， 需 要 指定 id 属性 。 
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尽管 VBA 中 已 经 有 很 多 用 于 字符 串 处 理 的 函数 ， 例 如 Like、Replace、Instr， 但 是 在 实 
际 编程 过 程 中 ， 以 上 函数 还 是 不 够 简单 ， 例 如 使 用 Like 验证 一 个 字符 串 是 不 是 恰好 为 一 个 
手机 号 ， 需 要 写成 Like "[0-9][0-9][0-9][0-9][0-9][o-9][0-9][0-9][o-9][0-9][0-9]"， 看 起 来 特别 
宛 长 。 再 例如 ， 验 证 一 个 字符 串 中 是 否 只 有 小 写 英文 字母 ， 需 要 在 循环 中 使 用 Mid 函数 提 
取出 每 一 个 字符 。 


Sub Test () 
Dim i Rs Integer, c As String 
Const words As String = "Excel 2013" 
For i = 1 To Len(words) 
c= Mid(words, i, 1) 
IE (c >= "a" Rnd c <= "z") Then 


Else 
MsgBox " 不 全 是 小 写字 母 "，vbExclamation 
End If 
Next i 
End Sub 


可 以 看 出 ,使 用 VBA 内 置 字符 串 函 数 ， 即 使 处 理 很 简单 的 一 个 任务 ， 也 需要 大 量 代 
码 ， 而 且 很 多 情况 下 必须 使 用 循环 结构 。 

正则 表达 式 ( Regular Expression， 简 称 RegExp)， 使 用 一 个 模式 来 表达 和 规范 某 一 类 字 
符 串 ， 从 而 可 以 快速 从 源 文本 中 进行 验证 、 蔡 换 和 查找 操作 。 实 际 上 ， 很 多 种 编程 语言 都 可 
以 使 用 正则 表达 式 ， 本 章 将 介绍 VBA 编程 中 如 何 使 用 正则 表达 式 。 

本 章 用 到 的 外 部 引用 和 重要 对 象 : 

口 Microsoff VBScript Regular Expressions 5.5 

> VBScript RegExp 55.RegExp 
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6.1 正则 表达 式 入 门 


正则 表达 式 的 作用 就 是 处 理 字 符 串 。 学 习 VBA 中 的 正则 表达 式 ， 重 点 学 习 模式 的 构造 
以 及 验证 、 蔡 换 和 查找 三 大 方法 。 
VBA 编程 中 使 用 正则 表达 式 的 流程 如 图 6-1 所 示 。 


创建 RegExp 对 象 


| 


设 定 RexExp 对 象 的 属性 
(Pattern、Global、IgnoreCase、MultiLine) 


引用 RegExp 对 象 库 ] 


执行 有 关 方 法 
Test、Replace、Execute 


| 


返回 结果 


图 6-1 正则 表达 式 的 使 用 流程 


6.1.1 引用 RegExp 


前 期 绑 定 : 在 VBA 编辑 器 中 单 击 【 工 具 / 引 用 】)， 勾 选 “ Microsoft VBScript Regular 
Expressions 5.5”， 如 图 6-2 所 示 。 
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而 cresoft VBScript Regular Expressions 5 5 一 一 


定位 : C:AWindows\systen32\vbscript. dll\3 
语言 : 标准 


图 6-2 添加 外 部 引用 
后 期 创建 对 象 。 


Set reg = CreateObject ("VBScript.RegExp") 


第 6 章 使 用 正则 表达 式 ”29 
本 章 按照 前 期 绑 定 方式 讲解 。 
6.1.2 创建 Regexp 对 象 


在 VBA 代码 中 声明 一 个 RegExp 对 象 ， 输 入 小 数 点 后 可 以 看 到 包含 4 个 属性 、3 个 方 
法 ， 如 图 6-3 所 示 。 


Sub 创建 正则 表达 式 对 象 () 
Dim Reg As VBScript RegExp_55. RegExp 
Set Reg = New VBScript_RegExp_55. RegExp 
With i 
End eens 
| End Sub Mtoemcs, 
Nultiline 
EP Pattern 


= Replace 
STest 


图 6-3 创建 正则 表达 式 对 象 
因此 ,正则 表达 式 的 编程 技巧 ， 就 在 于 Pattern 的 构造 和 各 个 方法 的 灵活 运用 。 
正则 表达 式 的 4 个 属性 中 ,模式 (Pattern) 是 最 主要 属性 ， 其 他 属性 是 对 Pattern 的 补充 
修饰 。 组 成 Pattern 的 基本 单位 是 元 字符 ， 元 字符 的 理解 掌握 ， 是 正则 表达 式 运用 的 重点 和 
难点 。 


6.1.3 ”模式 和 元 字符 


在 微软 Word 的 查找 文本 框 中 输入 的 内 容 ， 就 相当 于 正则 表达 式 中 的 模式 ( pattern)， 换 
名 话说，pattern 就 是 查找 目标 。 

组 成 pattern 的 字符 ， 既 可 以 是 确切 的 字符 ， 也 可 以 是 模糊 的 字符 (元 字符 )， 元 字符 通 
常 可 以 表达 一 系列 属于 同类 别 的 多 种 字符 ， 如 表 6-1 所 示 。 


表 6-1 正则 表达 式 元 字符 


字 符 描述 
* 转 义 字符 标志 
a 匹配 输入 字符 串 的 开始 位 置 
$ 匹配 输入 字符 串 的 结束 位 置 
二 匹配 前 面 的 零 次 或 多 次 的 子 表 达 式 
十 匹配 前 面 的 一 次 或 多 次 的 子 表达 式 
eg 匹配 前 面 的 零 次 或 一 次 的 子 表达 式 
{n} 1 是 一 个 非 负 整 数 ， 匹 配 前 面 的 n 次 子 表 达 式 
{n.} 1 是 一 个 非 负 整 数 ， 至 少 匹 配 前 面 的 n 次 子 表达 式 
{nm} Im 和 均 为 非 负 整 数 ， 其 中 nmn 入 m, 最 少 匹 配 n 次 且 最 多 匹配 m 次 
网 当 该 字符 紧 跟 在 其 他 限制 符 (*，+，?，{m}，{m.}， 各 ，m} ) 后 面 时 ， 匹 配 模式 尽 可 能 少 地 匹配 


所 搜索 的 字符 串 
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字符 措 述 
匹配 除 “wmn” 之 外 的 任何 单个 字符 
(pattern) 匹配 patterm 并 获取 这 一 匹配 结果 
(?:pattern) 匹配 patterm 但 不 获取 匹配 结果 
(?=pattermm) ”| 正 向 预 查 ， 在 任何 匹配 pattern 的 字符 串 开始 处 匹配 查找 字符 串 
(?Ipattern) 负 向 预 查 ， 在 任何 不 匹配 pattem 的 字符 串 开始 处 匹配 查找 字符 串 
xly 匹配 x 或 y。 例 如，'zlfood' 能 匹配 “z” 或 “food"; "(zlfDjood' 则 匹配 “zood” 或 “food” 
[xyz] 字符 集合 。 匹 配 所 包含 的 任意 一 个 字符 。 例 如 ，'[abc]' 可 以 匹配 “plain” 中 的 “a” 
[^xyz] 负 值 字 符 集合 。 匹 配 未 包含 的 任意 字符 。 例 如 ，'[^abc]' 可 以 匹配 “plain” 中 的 “p” 
[a-z] 匹配 指定 范围 内 的 任意 字符 。 例 如 ，'[a- 可 ' 可 以 匹配 'a' 到 'z 范围 内 的 任意 小 写字 母 字符 
[‘a-z] 匹配 不 在 指定 范围 内 的 任意 字符 。 例 如 ，'[^a-z]' 可 以 匹配 不 在 'a' ~ 'z' 内 的 任意 字符 
\b 匹配 一 个 单词 边界 ， 指 单词 和 空格 间 的 位 置 
B 匹配 非 单 词 边界 
\d 匹配 一 个 数字 字符 ， 等 价 于 [0-9] 
D 匹配 一 个 非 数字 字符 ， 等 价 于 [^0-9] 
让 匹配 一 个 换 页 符 
匹配 一 个 换行 符 
Y 匹配 一 个 回 车 符 
\s 匹配 任何 空白 字符 ,包括 空格 、 制 表 符 、 换 页 符 等 
补充 说 明 : 


由 于 在 正则 表达 式 中 “\W* “9” “#8” 4 ”1"“[” 等 字符 已 经 具有 
一 定 特 殊 意 义 ， 如 果 需 要 用 它们 的 原始 意义 ， 则 应 该 对 它 进行 转 义 ,例如 希望 在 字符 串 中 至 
少 有 一 个 “\”， 那么 正则 表达 式 应 该 这 么 写 :\+。 

例如 Pattern="A[1-9]"， 可 以 匹配 A3、A8， 但 不 可 以 匹配 A0， 也 不 可 以 匹配 B1。 这 是 
因为 Pattern 中 的 A 是 确切 字符 ，[1-9] 是 模糊 字符 ， 这 个 模糊 字符 可 以 匹配 到 1 ~ 9 中 的 任 
何 一 个 数字 。 


6.1.4 ”是 否 忽略 大 小 写 


正则 表达 式 对 象 的 IgnoreCase 属性 用 来 设置 是 否 忽 略 大 小 写 ， 这 是 一 个 可 以 读 写 的 布 
尔 值 ， 对 于 新 创建 的 RegExp 对 象 ， 其 默认 的 IgnoreCase 属性 为 False， 也 就 是 说 默认 严格 
区 分 大 小 写 。 

假定 源 文 本 是 "Our Computer"，Pattern="[a-z]+"， 当 IgnoreCase 属性 为 False 时 ， 匹 
配 到 ur 和 omputer; 当 IgnoreCase 属性 设置 为 True 时， 可 以 匹配 到 Our 和 Compnuter 两 个 
单词 。 因 为 "[a-z]+" 表示 连续 多 个 小 写字 母 ， 当 IgnoreCase 为 True 时 ， 大 写字 母 也 能 匹 
配 到 。 
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6.1.5 ”是否 多 行 模式 


正则 表达 式 对 象 的 MultiLine 属性 用 来 设置 是 否 为 多 行 模式 ， 默 认 值 为 False。 该 属性 主 
要 影响 ^“ 和 8$ 的 作用 。 

当 MultiLine 属性 为 False 时 ， 关 闭 多 行 模式 ， 此 时 ^ 只 能 匹配 字符 串 的 起 始 ，$ 只 能 匹 
配 字符 串 的 结尾 。 

当 MultiLine 属性 为 True 时 ， 开 启 多 行 模式 ， 此 时 ^ 既 能 匹配 字符 串 的 起 始 ， 也 能 匹配 
行 的 起 始 ; 5 既 能 匹配 字符 串 的 结尾 ， 也 能 匹配 行 的 结尾 。 


6.1.6 ”是否 全 局 搜索 


正则 表达 式 对 象 的 Global 属性 用 来 设置 是 否 全 局 搜索 ， 默 认 值 为 False。 

当 Global 为 False 时 ， 最 多 只 搜索 到 一 处 。 当 Global 为 True 时 ， 在 源 文本 中 查找 全 部 。 

假设 源 文本 为 :" 胡萝卜 35 公斤 土豆 231 公斤 西红柿 24 公斤 白菜 1234 公斤 "，Pattem= 
"d+"， 当 Global 为 False 时 ， 只 找到 35， 如 果 Gloal 为 Tme， 还 可 以 找到 后 面 的 三 个 数字 。 

Global 属性 主要 影响 Replace 和 Execute 方法 。 


6.2 格式 验证 测试 


正则 表达 式 对 象 的 Test 方 法 用 来 判断 源 文 本 是 否 符合 模式 规定 ,或 者 判断 能 否 查 找到 
一 处 以 上 ， 如 果 能 匹配 到 ， 则 返回 True， 否 则 返回 False。 
Test 方法 通常 用 于 判断 手机 号 码 是 否 合法 、 用 户 名 是 否 合法 等 。 


6.2.1 判断 是 否 包含 特定 的 字符 


使 用 Test 方 法 时 ， 当 Pattem 匹配 到 源 文本 中 至 少 一 处 时 ， 返 回 True。Test 的 用 法 是 ， 
首先 创建 正则 表达 式 对 象 ， 然 后 设置 其 Pattem， 最 后 向 Test 方 法 中 传递 源 文本 作为 参数 ， 
Test 方法 返回 一 个 布尔 值 。 

下 面 的 过 程 测试 源 文本 中 是 否 包 含 6 个 以 上 连续 的 数字 。 

Sub Find() 

Dim reg As New RegExp 
With reg 
.Pattern = "\d{6,}" 
MsgBox .Test("2018 年 ") 


End With 
End Sub 


结果 返回 False， 因 为 源 文本 中 找 不 到 连续 的 6 个 以 上 数字 。 
下 面 的 过 程 则 可 以 对 发 帖 内 容 进行 敏感 词汇 分 析 ， 如 果 在 发 帖 内 容 中 找到 至 少 一 个 敏感 
词汇 ， 就 弹出 警告 对 话 框 。 
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Sub 验证 是 否 包含 特定 词汇 () 
Dim 帖子 内 容 As string 
Dim reg As New VBScript RegExp 55.RegExp 
Dim result As Boolean 
帖子 内 容 = "我 制作 了 一 个 秒杀 所 有 Excel 操作 的 工具 ! " 
With reg 


.pattern = "枪手 | 秒杀 | 属 丝 ， a 
result = .Test( 帖子 内 容 ) 
If result Then @ 含有 敏感 词汇 ! 
MsgBox " 含有 敏感 词汇 ! "，vbCritical 
End If 
End With 
End Sub 
上 述 程序 的 运行 结果 如 图 6-4 所 示 。 图 6-4 验证 源 字符 串 中 是 否 有 特定 词语 


6.2.2 ”判断 源 文 本 中 是 否 只 包含 模式 


Test 方 法 还 可 以 用 于 验证 源 文本 是 否 恰好 为 模式 ， 例 如 验证 手机 号 格式 是 否 正确 ， 或 者 
论坛 注册 的 用 户 名 是 否 符合 规定 。 
手机 号 一 共 包含 11 位 数字 ， 其 中 第 1 位 必须 是 1, 第 2 位 是 3、4、5、7、8 之 一 ， 剩 
余 的 9 个 数字 则 是 任意 数字 即 可 。 因 此 可 以 构造 Pattern 为 "^1[3,4.5,7,8][0-9]{9}$"， 前 面 
加 人 ^ 表 示 以 1 开头 的 , 后 面 加 $ 表示 以 9 个 数字 结尾 的 ， 加 上 这 两 个 符号 就 可 以 实现 恰好 
匹配 。 
Sub 验证 是 否 为 有 效 手机 号 () 
Dim phone As String 
Dim reg As New VBScript RegExp 55.RegExp 


Dim result As Boolean 
phone = "138123456789" 


With reg 
.Pattern = "^1[3,4,5,7,8] [0-9] {9}$" 
result = .Test (phone) 


If result Then 
MsgBox " 号 码 有 效 "，vbInformation 
Else 
MsgBox " 无 效 号 码 "，vbExclamation 
End If 
End With 
End Sub 


上 述 过 程 中 ， 由 于 多 了 一 个 数字 ， 也 就 是 说 该 号 码 不 是 以 9 个 连续 数字 作为 结尾 ， 因 此 
弹出 “无 效 号 码 ” 对 话 框 。 

下 面 的 实例 在 VBA 的 用 户 窗 体 上 模拟 用 户 名 的 注册 ,假设 该 论坛 允许 的 用 户 名 只 能 由 
数字 、 字 母 、 下 画 线 组 成 ， 并 且 必 须 是 4 ~ 8 个 字符 。 

在 文本 框 的 Exit 事件 代码 中 ， 当 鼠标 指针 试图 离开 文本 框 时 进行 模式 验证 。 


Private Sub TextBox1l Exit (BYVal Cancel As MSForms .ReturnBoolean) 
Dim reg As New VBScript RegExp 55.RegExp 
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Dim result As Boolean 

With reg 
.IgnoreCase = True 
.Pattern = "^[0-9A-Zz ]{4,8}$" 
result = .Test (Me .TextBoxl .Text) 
If result = False Then 

MsgBox " 用 户 名 无 效 ， 只 允许 4 ~ 8 位 数字 、 字 母 、 下 画 线 ! "，vbExclamation 

End If 

End With 

End Sub 


由 于 用 户 名 允许 大 写 和 小 写 英文 字母 ， 因 此 设置 IgnoreCase 为 True。 启 动 窗 体 后 ， 输 
入 带 有 汉字 的 用 户 名 时 ， 弹 出 警告 对 话 框 ， 如 图 6-5 所 示 。 


天 医 浪子 2018 


全 用 户 名 无 效 ， 只 允许 4 一 8 位 数字 、 字母 、 下 画 线 1 


图 6-5 自动 判断 用 户 输入 的 内 容 是 否 符合 格式 要 求 


6.3 替换 


正则 表达 式 的 Replace 方法 可 以 把 根据 Pattern 匹配 到 的 目标 替换 为 其 他 字符 串 。 替 换 
后 ， 将 产生 一 个 新 字符 串 ， 但 是 并 不 会 破坏 源 文本 。 
Replace 方法 的 语法 如 下 。 


Result=RegExp.Replace (Source, Replacement) 
下 面 的 过 程 演示 了 3 个 不 同 的 替换 过 程 。 
Sub 替换 数字 () 


Dim Source As String 

Dim reg As New VBScript RegExp 55.RegExp 
Dim result As String 

Source = "2002 年 的 第 1 场 雪 " 


With reg 
.Pattern = "\d+" 
result = .Replace (Source, "#") 


Debug.Print result 

.Pattern = "\d" 

result = .Replace (Source, "#") 
Debug.Print result 

-Pattern = "\d" 
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-Global = True 


result = -Replace (Source， "#") 
Debug.Print result 
End With 
End Sub 


代码 分 析 : 上 述 过 程 先后 进行 了 三 次 替换 ， 第 1 次 的 Pattem 是 \d+， 表 示 连 续 的 多 个 
数字 替换 为 1 个 # 第 2 次 的 Pattem 是 \d， 表示 1 个 数字 就 替换 为 1 个 #。 但 由 于 前 两 次 
RegExp 的 Global 属性 均 为 False， 只 能 是 第 一 个 匹配 项 被 执行 到 替换 ， 后 面 不 变 。 

第 3 次 的 Pattem 依 然 是 \d， 但 是 设置 Global 为 
i tal | # 年 的 第 ] 场 雪 

运行 上 述 过 程 ， 三 次 替换 的 结果 如 图 6-6 所 示 。 #002 年 的 第 1 场 雪 

正则 表达 式 中 的 + 表示 贪 禁 匹 配 ， 把 尽 可 能 多 的 字 “| 机 村 年 的 第 # 场 雪 
符 当 作 一 个 匹配 项 。Global 属性 为 Trme 时， 表示 全 部 
替换 。 

另外 ，RegExp 的 IgnoreCase 属性 也 会 影响 到 Replace 的 结果 。 

下 面 的 过 程 把 英文 字母 以 外 的 其 他 字符 替换 为 空 字符 串 ， 也 就 是 删除 非 英 文字 符 。 

Sub 替换 字母 以 外 的 所 有 字符 () 

Dim Source As String 
Dim reg As New VBScript RegExp 55.RegExp 


Dim result As String 
Source = "Happy New Year 2018" 


图 6-6 替换 的 结果 


With reg 
.Global = True 
.Pattern = "[^A-Z]" 
result = .Replace (Source, "") 
Debug.Print result 
End With 
End Sub 


代码 分 析 : [^A-Z] 表示 A ~ Z 之 外 的 所 有 字符 ， 方 括号 内 的 ^ 表 示范 围 之 外 的 意思 。 
由 于 没有 设置 RegExp 的 IgnoreCase 属性 ， 所 以 默认 按照 区 分 大 小 写 处 理 ， 运 行 的 结果 是 
HNY， 发 现 删除 了 所 有 的 小 写 英 文字 母 。 

如 果 在 上 述 代码 中 插入 一 行 : .IgnoreCase = True， 再 次 运行 ， 结 果 为 HappyNewYear。 
以 上 就 是 IgnoreCase 属性 对 替换 结果 的 影响 。 

一 般 情况 下 ，Replace 方法 的 Replacement 与 被 替换 的 内 容 毫 无 关系 ， 但 在 某 些 场合 下 ， 
还 可 以 再 次 利用 匹配 到 的 目标 作为 Replacement 的 一 部 分 。 

下 面 的 程序 把 每 一 个 城市 的 区 号 转移 到 电话 号 码 的 后 面 。 


Sub 替换 包含 自身 () 
Dim Source As String 
Dim reg As New VBScript RegExp 55.RegExp 
Dim result As String 
Source 一 " 北京: 010-12345678， 沈阳 : 024-23456789， 呼 和 浩特 : 0471-3958123， 武 汉 : 
027-87654321" 
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With reg 
-Global = True 
.IgnoreCase = True 
“Pattern = ™(\dt})\=(\a+)™" 
result = .Replace (Source, "$2@$1") 
Debug.Print result 

End With 

End Sub 


代码 分 析 : 上 述 代码 中 的 Pattern 中 有 两 个 圆 括号 ， 分 别 把 连续 的 数字 括 住 ， 因 此 第 1 
个 圆 括号 构成 了 一 个 分 组 ， 那 么 在 Replace 方法 中 的 $1 就 代表 第 1 分 组 匹配 到 的 内 容 ，$2 
表示 第 2 个 分 组 。 

运行 上 述 过 程 的 结果 为 : 

北京 : 12345678@010， 沈阳: 23456789@024， 呼 和 浩特 : 395812380471, 武汉 : 87654321@027 


以 上 内 容 的 源 代码 文件 为 “实例 文档 41.xlsm”。 


6.4 查找 


正则 表达 式 经 常用 于 从 纷繁 复杂 的 源 文本 中 筛选 出 重要 的 信息 ， 也 就 是 目标 文本 的 匹配 
或 查找 。 

随 着 互联 网 技术 的 飞速 发 展 ， 网 页 上 巨大 的 信息 数据 需要 提取 和 重新 整合 ， 这 就 可 以 用 
正则 表达 式 从 网 页 显示 内 容 或 者 从 网 页 源 代码 进行 查找 ， 因 此 正则 表达 式 和 网 页 抓 取 技术 越 

下 面 是 网 页 上 的 一 段 话 ， 其 中 谈 到 哪些 省 份 呢 ? 

“2017 年 x x 大 学 录取 分 数 线 北京 : 理科 671 分 文科 668 分 ， 福建: 理科 649 分 文科 
637 分 ， 内 蒙古 : 理科 668 分 文科 647 分 ,广西 : 理科 659 分 文科 681 分 。” 

从 源 文本 中 定位 到 想 要 的 内 容 ， 一 定 要 观察 和 发 现 目标 附近 的 特点 ， 不 难看 出 ， 每 个 省 
份 的 后 面 都 有 个 中 文 冒 号 ， 因 此 可 以 用 这 样 的 语言 来 描述 : 

连续 多 个 汉字 后 面 有 个 冒号 ， 冒 号 前 面 的 部 分 就 是 省 份 名 称 ! 

所 以 Pattern 就 可 以 写作 : [一 - 颌 ]+: 

其 中 , 方 括号 那 部 分 用 来 匹配 任意 一 个 中 文 汉 字 ， 后 面 的 加 号 表示 连续 多 个 汉字 ， 最 后 
的 冒号 是 一 个 环境 标识 ， 因 为 源 文本 中 也 有 冒号 。 


6.4.1 MatchCollection 对 象 


正则 表达 式 使 用 Execute 方法 执行 查找 ， 查 找 后 返回 一 个 MatchCollection 集合 对 象 ， 
该 集合 对 象 包含 了 所 有 的 匹配 内 容 。 
下 面 的 过 程 从 源 文本 中 查找 所 有 的 省 份 名 称 。 


锚 office VBA 开发 经 典 一 中 级 进 阶 郑 


Sub 查找 全 部 () 
Dim Reg As New VBScript RegExp 55.regexp 
Dim MC As VBScript RegExp 55.MatchCollection 
Dim M As VBScript RegExp 55.Match 
Dim Source As String 
Source = "2017 年 Xx X 大 学 录取 分 数 线 北京 : 理科 671 分 文科 668 分 ,福建 : 理科 649 分 文科 
637 分 ， 内 蒙古 : 理科 668 分 文科 647 分 , 广西: 理科 659 分 文科 681 分 " 


With Reg 
-Global = True 
-Pattern = "[ 一 - 颌 ]+: " 
Set MC = -Execute (Source) 


Debug.Print MC.Count 
Set M = MC.Item(0) 
Debug.Print M.Value 
End With 
End Sub 


代码 分 析 : RegExp 的 Execute 方法 必须 以 源 文本 为 参数 ， 该 方法 返回 一 个 MatchCollection， 
如 果 找 到 目标 ， 那 么 该 对 象 的 Count 属性 大 于 0， 和 否则 等 于 0。 另 外 ， 一 般 情况 下 执行 
Execute 方法 时 ， 往 往 要 把 RegExp 的 Global 属性 设置 为 True， 否 则 只 能 


找到 第 一 个 匹配 项 。 
运行 上 述 过程 ， 立 即 窗口 中 打印 出 匹配 到 的 个 数 ， 以 及 第 1 个 匹配 北京 : 


项 的 值 ， 如 图 6-7 所 示 。 图 6-7 运行 结果 
6.4.2 Match 对 象 


Match 对 象 代表 每 一 个 匹配 项 ， 恰 好 是 MatchCollection 的 个 体 对 象 。 此 外 ，Match 匹配 
项 对 象 有 以 下 3 个 重要 属性 。 
口 FirstIndex: 匹配 项 出 现在 源 文本 中 的 位 置 (最 左边 是 0 )。 
口 Length: 匹配 项 的 长 度 。 
口 Value: 匹配 项 的 内 容 。 
下 面 的 过 程 遍历 MatchCollection 中 的 每 一 个 匹配 项 。 
Sub 遍历 匹配 项 () 
Dim Reg As New VBScript RegExp 55.regexp 
Dim MC As VBScript RegExp 55.MatchCollection 
Dim M As VBScript RegExp 55.Match 
Dim Source As String 


Source = "2017 年 x X 大 学 录取 分 数 线 北京 : 理科 671 分 文科 668 分 ， 福建: 理科 649 分 文科 
637 分 ， 内 蒙古 : 理科 668 分 文科 647 分 ， 广西: 理科 659 分 文科 681 分 " 


With Reg 
.Global = True 
-Pattern = "[ 一 - 颌 ]+: " 
Set MC = .Execute (Source) 


For Each M In MC 
Debug.Print M.FirstIindex, M.Length, M.Value 
Next M 
End With 
End Sub 
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运行 上 述 过 程 ， 立 即 窗 口 打印 出 每 个 匹配 项 - ns 
的 信息 ， 如 图 6-8 所 示 。 3 3 入 本: 
这 里 以 第 3 行 结果 为 例 ， 数 字 47 表示 内 蒙古 65 3 广西 : 
出 现在 第 47 个 位 置 ， 共 4 个 字符 。 图 6-8 查找 所 有 匹配 项 
在 实际 编程 过 程 中 ， 经 常 遍历 匹配 项 ， 把 结果 发 送 给 Excel 单元 格 或 数组 中 以 便 进一步 


利用 。 
实际 上 ，Match 对 象 的 三 大 属性 还 存在 如 下 关系 。 


Value=Mid(Source,FirstIndex+1l,Length) 


也 就 是 匹配 项 的 内 容 可 以 用 VBA 的 Mid 函数 结合 FirstIndex、Length 提取 出 来 。 
下 面 的 实例 提取 中 英文 混合 的 文章 段落 里 面 的 全 部 英文 单词 。 首 先 把 MatchCollection 
中 的 每 个 匹配 项 转移 到 字符 串 数组 中 ， 然 后 再 把 数组 赋 给 单元 格 区 域 。 


Sub 查找 所 有 单词 () 
Dim Reg As New VBScript RegExp 55.regexp 
Dim MC As VBScript RegExp 55.MatchCollection 
Dim M Rs VBScript RegExp 55.Match 
Dim Source As String 
Dim Result() As String 
Dim i As Integer 
Source = "Microsoft Word 是 文书 处 理 软件 ， 被 认为 是 Office 的 主要 程序 ， 在 文字 处 理 软 件 市 场 
上 拥有 鸡 断 份额 其 私有 的 DOC 格式 被 尊 为 一 个 行业 的 标准 ， 虽 然 由 Word 2007 年 已 经 转 用 DOCX 格式 。Word 也 
适宜 某 些 版 本 的 Microsoft Works。 它 适宜 Windows 和 Macintosh 平台 。 它 的 主要 竞争 者 是 Libreoffice、 
Corel WordPerfect 和 ApplePages。" 
With Reg 
.Global = True 
.IgnoreCase = True 
.Pattern = "[a-z]+" 


Set MC = .Execute (Source) 
ReDim Result (0 To MC.Count - 1) Rs String 
i=0 


For Each M In MC 
Result (i) = M.Value 


生生 -未 征 
Next M 
End With 
Range ("Al") .Resize (MC.Count) .Value = Application.WorksheetFunction.Transpose 
(Result) 
End Sub 
代码 分 析 : 由 于 可 能 存在 大 写 英文 字母 ， 所 以 要 把 2 | 
IgnoreCase 设 为 Tue。 在 匹配 之 前 不 知道 有 多 少 个 匹配 项 ， 因 ea 
此 需要 声明 一 个 动态 字符 串 数组 ， 当 执行 查找 后 再 根据 匹配 到 全 pe 
的 个 数 重新 定义 数组 大 小 。 ?ora 
8 Microsoft 
i 是 一 个 伴随 变量 ， 当 遍历 匹配 项 时 ， 自 增 1。 由 于 要 ere” 
把 一 维 数组 放 到 一 列 中 ， 所 以 最 后 用 到 了 工作 表 的 转 置 函数 Hcintosh 
Transpose。 se 
15 JApplePages 
执行 上 述 代码 ，Excel 中 的 A 列 出 现 所 有 英文 单词 ， 如 图 16| 


6-9 所 示 。 图 6-9 找 出 所 有 英文 单词 
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6.4.3 SubMatches 对 象 


正则 表达 式 允 许 在 Pattern 中 使 用 圆 括号 ， 括 起 来 的 内 容 将 形成 “ 子 匹 配 ”， 或 者 叫 小 
分 组 。 

还 是 以 高 考 录取 分 数 线 的 那 段 话 为 例 ， 如 果 要 找 的 除了 省 份 名 称 以 外 ， 还 要 把 相应 
的 理科 和 文科 分 数 也 提取 出 来 ， 那 需要 把 Pattern 修改 为 : [一 - 颌 ]+ : 理科 \d+ 分 文科 
\d+ 分 。 

本 实例 在 正则 表达 式 测 试 器 中 的 效果 如 图 6-10 所 示 。 


回 车 本 
[一 - 额 ]+: 理科 \d! 分 文科 \dt 分 


匹配 结果 
北京 : 理科 671 分 文科 668 分 
建 : 理科 文科 637 分 
广西 : 理科 659 分 文科 681 分 


图 6-10 不 使 用 分 组 的 情况 


可 以 看 到 ， 匹 配 到 的 内 容 中 ， 冒 号 没有 作用 ,“ 理 科 ” “文科 ” 这 些 常 量 也 没什么 用 。 因 
此 可 以 在 Pattem 中 把 想 要 的 重要 内 容 用 圆 括号 括 起 来 以 构成 分 组 ， 然 后 从 小 分 组 中 提取 。 
下 面 的 程序 使 用 分 组 提取 核心 内 容 。 


Sub 使 用 分 组 () 
Dim Reg As New VBScript RegExp 55.regexp 
Dim MC As VBScript RegExp_ 55.MatchCollection 
Dim M As VBScript RegExp_55.Match 
Dim Source As String 
Source = "2017 年 x x 大 学 录取 分 数 线 北京 : 理科 671 分 文科 668 分 ， 福建: 理科 649 分 文科 
637 分 ， 内 蒙古 : 理科 668 分 文科 647 分 ,广西 : 理科 659 分 文科 681 分 " 
With Reg 
.Global = True 
-Pattern = "([ 一 - 颌 ]+): 理科 (\d+) 分 文科 (\d+) 分 " 
Set MC = .Execute (Source) 
For Each M In MC 
Debug.Print M.SubMatches (0) M.SubMatches(1), M.SubMatches (2) 
Next M 
End With 
End Sub 


代码 分 析 : Patterm 中 通过 3 对 圆 括 号 来 包括 核心 内 容 ， 那 么 括号 外 部 的 内 容 就 是 无 用 
的 。 对 于 每 一 个 匹配 项 ， 都 有 3 个 SubMatches 对 象 ， 其 中 第 一 个 小 分 组 的 索引 是 0。 
运行 上 述 代码 ， 在 立即 窗口 可 以 看 到 这 段 内 容 的 核心 数据 ， 如 图 6-11 所 示 。 


北京 671 668 
福建 649 637 
内 蒙古 668 647 
广西 659 681 


图 6-11 使 用 分 组 的 结果 
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本 实例 在 正则 表达 式 测试 器 中 的 效果 如 图 6-12 所 示 。 


输入 正则 表达 式 后 按 回 车 执行 匹配 ; 按 下 箭头 4 打开 收藏 夫 。 
([ 一 - 额 ]+) : 理科 (\dr) 分 文科 (\dh) 分 


匹配 结 
日 一 北京 : 理科 671 分 文科 668 分 
2 
中 


668 
日 ~ 福建 : 理科 649 分 文科 637 分 
福建 


637 

日 一 内 蒙古 : 理科 668 分 文科 647 分 
内 蒙古 
668 
647 

日 ~ 广西 : 理科 659 分 文科 681 分 
广西 


659 
681 


图 6-12 使 用 分 组 的 情况 
正则 表达 式 测试 器 在 后 面 内 容 中 会 有 介绍 。 以 上 内 容 的 源 代码 文件 为 “实例 文档 


42.xlsm” 。 


6.5 ”元 字符 用 法 详解 


前 面 虽然 讲述 了 RegExp 在 VBA 编程 中 的 各 种 用 法 ,但 是 真正 提高 正则 表达 式 应 用 水 
平 的 瓶颈 是 对 元 字符 的 理解 。 只 有 很 好 地 理解 了 各 种 元 字符 的 含义 ， 才 能 书写 出 恰如其分 的 
Pattern。 因 此 本 节 总 结 归纳 一 下 各 类 元 字符 的 用 法 和 技术 点 。 


6.5.1 字符 范围 


表示 字符 范围 通常 有 以 下 三 种 方式 。 


1. 方 括号 

[bdg]os 可 以 匹配 bos、dos、gos。 

第 [1-8] 名 可 以 匹配 第 3 名 ， 但 是 不 可 匹配 第 9 名 。 

[我 你 他 X-Z] 好 可 以 匹配 我 好 、 你 好 、 他 好 、 义 好 、Y 了 好 、Z 好 。 

需要 注意 的 是 ，[A-z] 的 含义 与 [A-Za-z] 不 一 样 ， 前 者 可 以 匹配 大 小 写 英文 字母 外 ,还 
可 以 匹配 ASCII 码 值 在 91 ~ 96 的 字符 。 后 者 只 能 匹配 52 个 英文 字母 。 

方 括号 中 最 前 面 加 ^ 表 示范 围 的 补 集 。 例 如 [^ 你 我 他 ] 在 色 可 以 匹配 她 在 吗 , 但 是 不 可 
以 匹配 你 在 吗 。 

2. 转 义 字符 

\d 表示 0 ~ 9 的 一 个 数字 ， 等 价 于 [0-9],\D 是 \d 的 补 集 ， 等 价 于 [^0-9]。 

\s 能 匹配 任意 一 个 空白 字符 ,例如 空格 、 制 表 位 、 回 车 符 、 换 行 符 都 可 以 用 \s 匹配 到 。 
因此 \sr 的 范围 要 比 、r、tn 大 。\S 是 \ 的 补 集 ， 表示 任 意 一 个 非 空白 字符 。 
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Ww 能 匹配 字母 、 数 字 、 下 画 线 ， 相 当 于 [A-Za-z0-9 ]，\W 是 \w 的 补 集 。 

\b 匹配 英文 单词 边界 ， 例 如 在 句子 “I 工 have a pencil and a pen, What happened ?” 中 ， 
Pattern 为 pen 时 可 以 匹配 到 3 处 , 但 是 Pattem 换 为 \bpen\b 只 能 匹配 到 中 间 的 一 处 。 因 为 两 
边 加 上 \b 表示 两 边 再 没有 英文 字母 。 

3. 小数 点 

正则 表达 式 的 Pattem 中 ， 小 数 点 可 以 匹配 除了 换行 符 (m) 以 外 的 所 有 类 型 字符 ， 可 
以 说 小 数 点 的 表示 范围 是 最 大 的 ， 经 常 使 用 .+ 表示 连续 多 个 任意 字符 。 在 VBA 中 ， 回 车 符 
(Yr) 用 vbCr 生成 ， 换 行 符 (m) 用 vbLf 生 成 ,而 vbCr& vbLf 可 以 写作 vbNewLine。 


6.5.2 ”多 个 可 选 


使 用 竖 杠 分 隔 各 个 词汇 ， 可 以 实现 多 个 可 选 ， 例 如 用 ( 哈密 | 冬 | 老太婆 ) 瓜 去 匹配 句子 : 
“早上 吃 了 冬瓜 汤 ， 一 个 哈密 瓜 花 了 很 多 钱 ， 至 于 老太婆 瓜 不 大 喜欢 吃 。” 
匹配 到 3 处 ， 并 且 形 成 了 小 分 组 ， 如 图 6-13 所 示 。 


输入 正则 表达 式 后 按 回 车 执行 匹配 ; 按 下 荫 头 | 打开 收藏 天 。 
[8 密 | 冬 | 老太婆 ) 瓜 


匹配 藻 果 
日 ~ 冬瓜 


冬 

日 一 哈密 瓜 

日 -老太婆 瓜 _ 
老太婆 


图 6-13 组 中 的 多 个 词汇 之 一 
如 果 去 掉 圆 括号 ， 直 接 用 哈密 | 冬 | 老太婆 瓜 ， 匹 配 结果 如 图 6-14 所 示 。 


输入 正则 表达 式 后 按 回 车 执行 匹配 ; 按 下 箭头 打开 收藏 夹 。 
哈密 | 冬 | 老 太 溉 凤 
匹配 结果 

冬 

哈密 

老太婆 瓜 


图 6-14 外 部 的 多 个 词汇 之 一 


6.5.3 “环境 修饰 


使 用 环境 修饰 ， 可 以 匹配 处 于 某 些 特定 位 置 的 内 容 ， 环 境 修饰 符 本 身 不 会 成 为 匹配 内 
容 ， 只 起 到 一 个 参考 的 作用 。 常 用 的 环境 修饰 符 如 下 。 
口 b 和 \B: \b 是 匹配 单词 边界 ， 前 面 已 经 经 过 。 
口 ^ 和 $: ^ 匹 配 行 的 开头 。 当 MultiLine 为 True 时 ， 匹 配 每 行 的 开头 位 置 。$ 匹配 行 的 
结尾 。 
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针对 下 面 的 4 行 英文 歌词 ，Pattem 为 ^[a-z]j+ 时 ， 可 以 匹配 到 每 行 开头 的 4 个 单词 ， 如 
图 6-15 所 示 。 


回 车 执行 区 配 ; 按 下 箭头 打开 


when they get to the part 

he’ s breaking her heart 
Iwhen I was young 
|when they played 


图 6-15 ”匹配 行 首 
Pattern 为 [a-z]+$ 时 ， 匹 配 每 行 尾部 的 完整 单词 ， 如 图 6-16 所 示 。 


|when they get to the part 
| |where he' s breaking her BE 


图 6-16 ”匹配 行 尾 


6.5.4 ”重复 多 次 


在 一 个 字符 或 者 一 个 字符 范围 后 面 加 上 花 括号 ， 表 示 前 面 字符 重复 多 次 的 意思 。 

例如 \d{4} 表示 恰好 匹配 4 个 数字 ,\d{.4} 表示 0 ~ 4 个 数字 ,\d{4.} 表示 4 个 以 上 数字 ， 
\d{4,7} 表示 4 ~ 7 个 数字 。 

表达 重复 个 数 范 围 ， 还 有 以 下 3 种 简写 形式 。 

口 {0,}: 0 个 以 上 ， 简 写 为 *。 

口 {1,}: 1 个 以 上 ， 简 写 为 +。 

口 {0,1}: 0 个 或 1 个 ， 简 写 为 ?。 

例如 \d+\.?\d+ 去 匹配 下 面 这 行文 字 : 

“小 王 年 龄 36 岁 ， 身 高 1.75m。” 


A 36, LISs 
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6.5.5” 贪 梦 和 非 贪 梦 


正则 表达 式 中 ? 的 含义 相当 复杂 ,使 用 场合 不 同 ,含义 也 随 之 不 同 。 

? 的 含义 一 般 是 {0.1}， 表 示 重 复 次 数 。 要 表达 问号 本 身 ， 需 要 使 用 \?。 

例如 Pattern 为 老 李 吧 \?? 你 怎么 样 ， 可 以 匹配 老 李 吧 你 怎么 样 ， 中 间 的 问号 可 有 可 无 。 

此 外 ，? 还 经 常 跟 在 重复 次 数 的 后 面 ， 此 时 的 含义 是 非 贪 禁 ， 也 就 是 最 短 匹 配 。 

例如 a{m,n}? 只 能 匹配 到 m 个 连续 的 a， 如 果 去 掉 ?， 则 尽 可 能 地 去 匹配 mn 个 a。 

不 使 用 ? 时 ， 默 认 贪 禁 匹 配 ， 也 就 是 尽 可 能 多 向 后 搜索 。 例 如 [A-Za-z]{2,} 表示 匹配 2 
个 以 上 连 在 一 起 的 英文 字母 ， 如 图 6-17 所 示 。 


CE se 


Tt was songs of love that I would sing to them “| [ERs 


位 置 : 0; 长 度 : 0 | 共 10 顺 
图 6-17 贪 禁 模式 


在 花 括 号 后 面 加 ?， 成 为 非 贪 禁 模 式 ， 此 时 尽 可 能 形成 比较 短 的 匹配 ， 只 要 凑 够 2 个 连 
续 的 英文 字母 就 成 为 一 个 匹配 内 容 ， 如 图 6-18 所 示 。 


te i 4 CE 


| 
| 和 ER 双击 文本 框 自动 开盘 贴 板 中 的 网 址 。 和 回 车 执行 匹配 按 下 箭头 | 打开 收藏 赤 。 
| -Zarz] {2, 


ls songs of love that I would sing to them “ 


位 置 : 3; 长 度 : 2 


图 6-18 非 贪 焚 模 式 
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6.6 正则 表达 式 测试 器 


正则 表达 式 测 试 器 是 笔者 利用 VB6 开发 的 Windows 应 用 程序 ， 基 本 的 功能 就 是 在 左 侧 
文本 框 输入 源 文 本 ， 在 右 侧 输入 正则 表达 式 ， 然 后 按 下 回 车 键 查 看 输出 的 匹配 结果 。 

新 版 的 正则 表达 式 测试 器 还 增加 了 获取 网 页 源 代码 的 功能 ,输入 网 页 的 ul 并 按 下 回 车 
键 ， 网 页 源 代码 会 出 现在 左 侧 文本 框 内 成 为 正则 表达 式 的 源 文本 ， 如 图 6-19 所 示 。 


笨 入 正则 帮 这 式 所 党 回 车 执行 [9 到: 接 下 向 头 打开 收 基 未 。 
Teer "hts: /ishi. gi. son(. 17] /indea. html ”title 条) 阳历 更 天 气 ” trgetE "blanb Ty 


ethttp: /lsh tianqi con /anyane /indor, htal” title- "实用 历史 天 气 ” -| 


p11ishi. tiangi. confbiyang/index.htal”title=" 沦 用 历史 天 气 ”targ 
ye 


Hy 
href- http://1ishi. tianqi coa/binyane /indcx. htal” lo" 宫 阳历 史 天 气 ” tar 
Shinyane 


百 
href= -httpz//1iahi tianqi coa/chacyang/indor. htal” titlo= "朝阳 历史 天 气 ”ta 
cbaamant 


后 -hzref=httpz/A/aishi- tinngi. casjehaoyangl/index-htal title=" 朝 阳历 史 天 气 ”+ 
epaogangl 


所 hrefr http: /lishi. tianoi. ceafchenrrang/indexchtal- titler 党 图 历史 天 气 ” + 
/chonerene 


lsshi, tianss com/ babuqu/ snden. btnl” title 


sa ia om /hema /inne ES href="http: //1ishi. riangi. con/changyang/index. htal”title=“ 长 阳历 史 天 气 ”*+ 


haoyane2/index.htal1” tit1e=" 齐 图 历史 天 气 ” + 


潮 

白 。 hrefr-httpz//1ishi tianqi coa/danyane /index. htal” titlor“ 同 阳 历史 天 气 ” tar 
/dane 
月 


tp /ieht. tiangi, con/hanting findex. hr 
tn: 1113 shx tiana2, con/baronshuoer/ine 
/sehi thanas, con/bashoul /indez. hr 


Yj 则 历史 天 气 ” tn 


图 6-19 正则 表达 式 测试 器 界面 
软件 还 支持 附件 、 表 格 自 动 下 载 、 模 拟 真 实 浏览 器 的 功能 ， 读 者 可 以 从 本 书 配套 资源 下 
载 到 本 软件 。 


6.7 “本章 小 结 


正则 表达 式 是 字符 串 处 理 最 强大 的 工具 ， 可 以 在 很 多 编程 语言 中 使 用 。 

正则 表达 式 最 重要 的 必需 属性 是 Pattem， 这 个 属性 指明 了 要 查找 的 目标 。Test 方 法 用 于 
验证 源 字符 串 是 否 符合 指定 的 格式 ，Replace 方法 用 于 把 查找 到 的 目标 替换 为 指定 的 字符 串 。 

正则 表达 式 的 Execute 方 法 用 于 查找 ， 通 常 返回 多 个 查找 结果 ， 形 成 一 个 
MatchCollection 对 象 ， 该 对 象 的 个 体 对 象 是 Match， 如 果 Pattern 中 包含 分 组 ， 还 可 以 使 用 


SubMatches 从 Match 中 取出 每 个 分 组 。 


nl 


站 使 用 字典 


字典 (Dictionary) 是 一 种 键 值 对 (Key-Value pair) 的 集合 对 象 ， 通 常 唯一 的 键 可 以 直接 
访问 到 对 应 的 值 。 在 很 多 情况 下 使 用 字典 比 数组 要 方便 很 多 。 

字典 在 形式 上 特别 类 似 于 只 有 两 列 的 二 维 数组 ， 其 中 第 1 列 称 作 “ 键 ”( Key), 第 2 列 
称 作 “ 值 ”(Value)。 其 中 键 不 允许 重复 ， 如 图 7-1 所 示 。 

城市 和 它 对 应 的 区 号 就 形成 了 一 个 键 值 对 ， 例如: 保定 一 0312 


是 一 个 键 值 对 ， 保 定 是 键 ，0312 是 值 。 图 中 所 示 的 字典 总 共有 11 个 ” 嵌 归 证- 名 

| Pn 保定 0312 

键 值 对 (11 行 )。 张家口 |0313 

假如 要 查询 保定 的 区 号 是 多 少 ，dic(" 保定 ") 就 可 以 返回 0312， ”| 承德 。” |0314 

无 须 遍历 每 个 城市 。 廊坊 ie 

从 总 体 上 讲 ， 一 个 字典 的 所 有 键 构成 了 一 个 Keys 对 象 ， 该 对 象 ” 认 信 一 81 
表达 了 字典 中 的 所 有 键 ， 可 以 传递 给 一 维 数组 。 字 典 的 所 有 值 构成 了 | 邢台 |o319 | 

秦皇岛 10335 


一 个 Items 对 象 ， 也 可 以 传递 给 一 维 数 组 。 
本 章 讲解 在 VBA 编程 过 程 中 字典 的 创建 、 维 护 ， 以 及 使 用 字典 ”图 71 字典 的 刍 和 值 
实现 去 除 重复 项 的 具体 应 用 案例 。 
本 章 用 到 的 外 部 引用 和 重要 对 象 : 
口 Microsoft Scripting Runtime 
> Scripting.Dictionary 


7.1 字典 对 象 


在 VBA 中 使 用 字典 ， 需 要 添加 外 部 引用 “Microsoft Scripting Runtime”， 前 面 介绍 FSO 
对 象 处 理 文件 时 曾经 使 用 过 这 个 引用 ， 如 图 7-2 所 示 。 
后 期 绑 定 创建 Dictionary 对 象 的 方法 : CreateObject("Scripting.Dictionary")。 
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引用 -VBAProject 
可 使 用 的 引用 0); 
匡 带 | 


Visual Basic For Applications 


st Excel 15.0 Object Le 站 

OLE Automation - 

| EE Dffice 15.0 Object Libray 浏览 四 )…. 
ve ripting Runtine 


DAccountProtect 1.0 Type Library 
口 Aerobat 
口 Aerobat Access 3.0 Type Library 
口 Aerobat Distiller 

ovohet Saan 1 N Teme Tihrerm 
‘ » 


定位 : C:\Windows\system32\serrun. dll 


| 语言 : 标准 


图 7-2 添加 外 部 引用 


| Scripting Runtime 


7.1.1 字典 的 属性 和 方法 


当 VBA 工程 添加 了 字典 的 外 部 引用 ， 按 下 【 F2 】 刍 打开 VBA 的 对 象 浏览 器 ， 在 类 别 


中 选择 “Scripting”， 关 键 字 搜索 “dictionary”， 可 以 看 到 Dictionary 对 象 的 所 有 属性 和 方 
法 ， 如 图 7-3 所 示 。 


CT TY 一] 


外 是 YBAProject (实例 文档 
用 全 出 crosoft Exeel 对 入 
什 ] Sheetl (Sheet!l) 
Sheet2 (Sheet2) 
Sheet3 (Gheet3) 
This¥orkbook 


gp Conparallethod 

Pp DriveTypeConst 

Pp 了 ileAttribate 

2 TOMode 

Pp SpecialFolderConst 
StandardStremTypes 
Ep Tristate 


Sub Addlfey, Ttea 


ScriptingDictienary 的 成 员 
添加 一 个 新 的 关键 字 及 项 目 到 字 奥 中 。 


图 7-3 字典 对 象 的 成 员 


了 解 Dictionary 对 象 的 成 员 有 助 于 快速 掌握 字典 的 使 用 技巧 ， 最 主要 的 成 员 和 功能 如 
表 7-1 所 示 。 
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表 7-1 Dictionary 对 象 的 主要 成 员 及 其 功能 


成 员 名 称 功 能 代码 示例 
CompareMode | 设置 字典 的 键 是 否 区 分 大 小 写 ， 默 认为 二 进 制 比较 模式 “| dic.CompareMode=TextCompare 
Count 返回 字典 所 包含 的 键 值 对 总 数 MsgBox dic.Count 
Item 设置 或 返回 字典 指定 键 名 的 键 值 MsgBox dic.Item(" 北京 ") 
Key 修改 键 名 dic.Key(" 北京 ")="Beijing" 
Add 添加 新 的 键 值 对 ， 如 果 已 存在 键 名 ， 则 会 出 错 dic.Add " 北京 ", 2008 
Exists 判断 是 否 存 在 某 键 名 MsgBox dic.Exists(" 北京 ") 
Ttems 所 有 键 值 组 成 的 数组 arr=dic.Items 
Keys 所 有 键 名 组 成 的 数组 arr=dic.Keys 
Remove 移 除 指定 键 名 的 键 值 对 dic.Remove " 北京 " 
RemoveAll 移 除 所 有 键 值 对 dic.RemoveAll 


7.1.2” 键 值 对 的 添加 


创建 一 个 新 的 字典 对 象 后 ， 就 可 以 使 用 dic.Add 方法 或 者 dic.Item(" 键 ")= 值 的 形式 添 


加 新 的 键 值 对 
下 面 的 过 程 演示 了 创建 字典 对 象 并 添加 键 值 对 的 过 程 
Sub 键 值 对 的 添加 () 


Dim dic As Scripting.Dictionary 
Set dic = New Scripting.Dictionary 
With dic 
.Rdd "邯郸 "，"0310" 
-Rdd "石家庄 "，"0311" 
.Rdd "保定 "，"0312" 
.Rdd "张家口 "，"0313" 
.Rdd "承德 "，"0314" 
.Rdd "唐山 "，"0315" 
.Rdd "廊坊 "，"0316" 
.Rdd "沧州 "，"0317" 
.Rdd "衡水 "，"0318" 
-Rdd "邢台 "，"0319" 
.Rdd " 秦皇岛 "，"0335" 
Debug .Print " 键 值 对 总 数 : "， .Count 
Debug .Print "廊坊 的 区 号 是 : "， .Item(" 廊坊 ") 
End With 
End Sub 


代码 分 析 : 根据 键 获取 其 对 应 值 的 表达 形式 是 dic.Item(" 廊坊 ")， 其 中 Item 可 以 不 写 ， 


因此 dic(" 廊坊 ") 就 是 廊坊 对 应 的 区 号 。 

运行 上 述 过 程 ， 立 即 窗口 的 结果 如 图 7-4 所 示 。 

需要 注意 的 是 ， 一 个 字典 对 象 往往 会 让 不 同 的 模块 、 
过 程 访问 ， 因 此 在 实际 开发 中 经 常 把 Dictionary 对 象 声 明 
为 模块 级 ， 如 果 声 明 为 过 程 级 别 ， 当 创建 字典 的 代码 过 程 
执行 完 后 ， 字 典 就 自动 释放 了 。 


键 值 对 总 数 : 11 
廊坊 的 区 号 


号 是 : 0316 


图 7-4 获取 键 值 对 的 总 数 以 及 
指定 键 对 应 的 值 
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7.1.3” 键 值 对 的 修改 


在 实际 编程 应 用 中 ， 经 常 需要 在 已 有 键 值 对 的 基础 上 更 改 个 别 键 值 对 的 内 容 。 

修改 值 的 方法 是 : dic.Item(" 键 ")= 新 值 。 

修改 键 名 的 方法 是 : dicKey(" 旧 键 名 ") = 新 键 名 。 

下 面 的 过 程 为 字典 添加 一 部 分 键 值 对 后 修改 保定 的 区 号 为 312， 并 且 把 廊坊 的 键 名 修改 
为 LangFang。 


Sub 键 值 对 的 修改 () 

Dim dic As Scripting.Dictionary 
Set dic = New Scripting.Dictionary 
With dic 

.Rdd " 邯郸"，"0310" 

.Add " 石家庄"，"0311" 

.Rdd "保定 "，"0312" 

.Rdd "张家口 "，"0313" 

.Rdd "承德 "，"0314" 

.Rdd "唐山 "，"0315" 

.Rdd " 廊坊"，"0316" 

.Rdd "沧州 "，"0317" 

-Rdd "衡水 "，"0318" 

.Rdd "邢台 "，"0319" 

.Rdd "秦皇岛 "，"0335" 


.Item(" 保定 ") = "312" 
.Key(" 廊坊 ") = "LangFang" 


Debug.Print "保定 区 号 : "， .Item(" 保定 ") 
Debug.Print "廊坊 区 号 : "， .Item("LangFang") 


End With 立即 窗口 
a | 保定 区 号 : 312 
运行 上 述 代码 ， 立 即 窗口 的 结果 如 图 7.5 所 示 。 廊坊 区 与 : 0316 
图 7-5 修改 键 和 值 


特别 提示 
使 用 dic.Item 方法 时 ， 如 果 键 名 已 经 存在 ， 则 修改 现 有 键 值 ; 如 果 键 名 不 存在 ， 则 新 建 
一 个 键 值 对 。 例 如 以 下 3 行 代码 。 


dic.Adqd "语文 "，88 

dic.Item(" 数学 ") = 95 

dic.Item(" 语文 ") = 79 

第 1 行 代码 为 字典 添加 “语文 ”的 成 绩 为 88 分 。 由 于 字典 目前 不 存在 “数学 ”， 所 以 第 
2 行 的 功能 是 添加 “数学 ”成 绩 95 分 。 在 第 3 行 代码 中 ， 由 于 字典 中 已 存在 “语文 ”成 绩 ， 
所 以 该 行 相当 于 刷新 语文 成 绩 为 79 分 。 

因此 ， 执 行 上 述 3 行 代码 后 ，dic 总 共有 2 个 键 值 对 ， 语 文 =79， 数 学 -95。 
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7.1.4” 键 值 对 的 移 除 


字典 对 象 的 Remove 方法 用 于 移 除 一 个 键 值 对 ，RemoveAll 方 法 用 于 清空 字典 。 

例如 dic.Remove Key:=" 邢台 "， 就 移 除 邢台 这 个 键 值 对 ， 字 典 的 Count 属性 也 相应 减 
少 1。 

dic.RemoveAll 用 于 清空 整个 字典 ， 当 然 ， 也 可 以 用 Set dic=New Dictionary 重新 创建 新 
字典 。 


7.1.5 “指定 的 键 是 否 存在 


字典 的 Exists 方法 可 以 验证 某 个 键 是 否 在 字典 里 面 。 很 多 情况 下 Exists 方法 和 Add 方 
法 配合 使 用 ， 可 以 选择 性 地 添加 新 的 键 值 对 。 
如 果 字 典 中 已 经 存在 一 个 键 ， 那 么 不 能 再 用 Add 方法 继续 添加 该 键 名 ， 否 则 会 弹出 错 
误 对 话 框 。 
IE dic.Exists(" 辛集 ") Then 
MsgBox " 已 存在 辛集 ! " 
Else 


dic.Rdd "辛集 "，"0311" 
End If 


7.1.6 ”遍历 字典 
字典 由 两 列 构成 ， 而 且 键 列 和 值 列 的 行 数 一 样 ， 因 此 在 遍历 字典 的 时 候 ， 通 常 采用 键 和 


值 分 别 遍 历 的 方式 。 
下 面 的 过 程 使 用 了 3 个 For 循环 ， 分 别 遍 历 字典 的 键 、 值 、 键 值 对 。 
Sub 键 值 对 的 修改 () 
Dim dic Rs Scripting.Dictionary 
Dim v 


Dim i As Integer 

Set dic = New Scripting.Dictionary 

With dic 
.Rdd "邯郸 "，"0310" 
“Add “顾家 庄 "，*"=0311" 
-Rdd "保定 "，"0312" 
.Rdd "张家口 "，"0313" 
.Rdd "承德 "，"0314" 
-Rdd "唐山 "，"0315" 
.Rdd "廊坊 "，"0316" 
.Rdd " 沧州 "，"0317" 
.Rdd "衡水 "，"0318" 
-Rdd "邢台 "，"0319" 
-Rdd " 秦皇岛 "，"0335" 


For Each v In .Keys 
Debug.Print v 
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Next Vv 


For Each v In .Items 
Debug.Print v 
Next Vv 


For i=0 To -Count -1 
Debug.Print .Keys(i), .Items (i) 
Next i 
End With 
End Sub 


代码 分 析 : 当 采 用 数字 下 标 遍 历时 ， 要 注意 字典 对 象 的 下 界 是 从 0 开始 ， 因 此 循环 遍历 


的 终止 值 是 dic.Count-1。 


由 于 字典 的 所 有 键 Keys 相当 于 一 个 一 维 字符 串 数组 ， 因 此 ， 可 以 整体 发 送 到 Excel 单 


元 格 中 。 
下 面 的 过 程 分 别 把 字典 的 键 、 值 整体 发 送 到 相应 单元 格 区 域 中 。 
Sub 发 送 到 单元 格 () 


Range ("Al") .Resize(，dic.Count) 
Range ("A2") .Resize(, dic.Count) 


dic.Keys 
dic.Items 


Range ("B5") .Resize (dic.Count) = Application.WorksheetFunction.Transpose 


(dic.Keys) 


Range ("C5") .Resize (dic.Count) = Application.WorksheetFunction.Transpose 


(dic.Items) 
End Sub 


代码 分 析 : 如 果 发 送 到 一 行 中 ， 需 要 把 单元 格 区 域 的 列 数 用 Resize 方法 扩展 到 和 字典 


键 值 对 总 数 一 样 才 行 。 


如 果 发 送 到 一 列 中 ， 要 扩展 单元 格 区 域 的 行 数 ， 并 且 采 用 工作 表 的 转 置 函数 处 理 一 下 。 


运行 上 述 过 程 ， 单 元 格 中 显示 字典 的 所 有 键 值 对 ， 如 图 7-6 所 示 。 


石家庄 311 

保定 312 

张家口 313 
9 承德 314 
10 唐山 315 
11 廊坊 316 
12 沧州 317 
13 衡水 318 
14 邢台 319 
15 秦皇岛 335 


图 7-6 ”把 字典 的 键 和 值 发 送 到 横向 、 纵 向 单元 格 区 域 


7.1.7 ”字典 的 比较 模式 


字典 的 CompareMode 属性 有 以 下 3 种 取 值 。 
口 BinaryCompare: 二 进 制 模式 。 
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口 DatabaseCompare: 数据 库 模式 。 

口 TextCompare: 文本 模式 。 

默认 属性 是 BinaryCompare， 也 就 是 严格 区 分 大 小 写 ， 这 种 情况 下 ， 如 果 字 典 中 已 经 有 
China 这 个 键 ， 那 么 再 添加 一 个 china 也 是 可 以 的 。 

如 果 创 建 字 典 并 设置 比较 模式 为 TextCompare， 那 么 会 把 China 和 china 看 作 是 相同 的 
键 ， 如 图 7-7 所 示 。 


[加 用 了 了] |[ 字 岗 的 比 科 模式 
Sub 字典 的 比较 模式 () 
im dic As New Scripting.Dictionary 
With dic 
CompareMode = TextCompare 
Add “China”, “Beijing” 
.Add “Korea”, “Seoul” 
.Add "Japan”, “Tokyo” 
.Add “china”, “shanghai” 
End With 
End Sub 


图 7-7 文本 模式 下 大 写 和 小 写 的 键 名 被 认为 相同 


7.1.8 字典 的 数据 类 型 


为 了 讲解 方便 ， 前 面 所 述 实例 中 的 键 和 值 均 采 用 了 字符 串 类 型 ， 实 际 上 字典 的 键 、 值 还 
可 以 是 其 他 数据 类 型 。 
下 面 过 程 中 用 到 了 4 个 字典 ， 每 个 字典 的 键 和 值 用 了 不 同 的 数据 类 型 。 


Sub 不 同 数据 类 型 () 

Dim D1 As New Scripting.Dictionary 
Dim D2 As New Scripting.Dictionary 
Dim D3 As New Scripting.Dictionary 
Dim D4 As New Scripting.Dictionary 
With D1 

.Rdd 1, #1/31/2018# 

-Add 2, #2/28/2018# 

.Rdd 3, #3/31/2018# 

-Add 4, #4/30/2018# 

Debug.Print .Item(3) " 查询 键 名 为 3 的 值 
End With 


With D2 
.Add True, "Yes" 
.Add False, "No" 
Debug.Print .Iteml(False) 
End With 


With D3 
-Rdd 3.14, 22 / 7 
-Rdd 2.71828, VBA.Exp(1) 
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Debug.Print .Item(3.14) 
End With 


With D4 
.Add Key:="App", Item:=Application 
.Add Key:="Wbk", Item:=Application.ActiveWorkbook 
-Rdd Key:="Wst", Item:=Application.Activesheet 
.Add Key:="Rng", Item:=Application.ActiveCell 
Debug.Print .Item("App") .UserName 
Debug.Print .Item("Wbk") .Name 
Debug.Print .Item("Wst") .Name 
Debug.Print .Item("Rng") .Address 

End With 

End Sub 


代码 分 析 : 上 述 程序 包含 4 个 不 同 的 字典 ，D1 的 数据 类 型 


2018/3/31 
No 
3. 14285714285714 


是 nteger 一 Date，D2 是 Boolean 一 String，D3 是 Double 一 “| ryueifu 
实例 文档 43. xlsm 


Double，D4 是 String 一 对 象 变量 。 Sheet1 
运行 上 述 过程 ， 立 即 窗口 的 结果 如 图 7-8 所 示 。 D4 
以 上 内 容 的 源 代码 文件 为 “实例 文档 43.xlsm”。 图 7-8 运行 结果 


7.2 ”字典 的 应 用 
字典 的 特性 是 不 能 有 重复 的 键 名 。 因 此 经 常 利用 这 个 特性 实现 去 除 重复 。 
7.2.1 提取 单列 数据 中 的 唯一 值 


假设 工作 表 A 列 中 有 一 些 姓名 ， 很 多 姓名 出 现 了 多 次 ， 现 在 要 求 不 重复 的 姓名 有 哪些 。 
下 面 的 代码 把 姓名 作为 字典 的 键 名 创建 键 值 对 ， 至 于 每 个 键 对 应 的 值 ， 什 么 都 可 以 ， 本 
例 直 接 赋 空 字符 串 。 


Sub 单列 去 重 () 
Dim dic As New Scripting.Dictionary 
Dim i As Integer 
With dic 
For i=1 To 15 
.Item(Range ("A" & i).Value) = "" 
Next i 
Range ("C1") .Resize(.Count) .Value = Application.WorksheetFunction.Transpose 
(.Keys) 
End With 
End Sub 


代码 分 析 : For 循环 体 结束 后 ， 字 典 的 总 数 一 定 比 循环 次 数 少 ， 最 后 把 字典 的 所 有 键 发 
送 到 单元 格 。 结 果 显 示 : 不 重复 的 姓名 仅仅 5 个 ， 如 图 7-9 所 示 。 
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图 7-9 利用 字典 去 除 重复 项 


7.2.2 ”删除 重复 行 


虽然 Excel 2010 以 上 版 本 都 自 带 删 除 重复 项 的 功能 ， 这 里 为 了 演示 字典 的 特性 ， 借 助 
字典 标记 和 删除 重复 行 。 

假设 工作 表 中 有 一 个 学 生成 绩 表 ， 下 面 的 代码 可 以 把 重复 的 记录 底 纹 颜 色 设置 为 红色 。 
然后 再 把 所 有 底 纹 为 红色 的 单元 格 删除 。 

Sub 删除 重复 行 () 


Dim dic Rs New Scripting.Dictionary 
Dim i As Integer 
With dic 
For i=2 To 15 
IE .Exists(Range("A" & i).Value) Then 
Range ("A" & i) .Resize(，4) .Interior.Color = vbRed 


Else 
.Add Key:=Range ("A" & i).Value, Item:="" 
End If 
Next i 


MsgBox " 接 下 来 删除 重复 行 ! "，vbInformation 
For i = 15 To 2 Step -1 
IE Range("A" & i) .Resize(，4) .Interior.Color = vbRed Then 
Range ("A" & i).Resize(, 4) .Delete Shift:=Excel.XlDeleteShift 
Direction.xlShiftUp 
End If 
Next i 
End With 
End sub 


代码 分 析 : 本 过 程 包含 2 个 循环 结构 ， 第 一 个 循环 用 来 把 A 列 的 姓名 添加 到 字典 ， 如 
果 字 典 中 已 经 存在 某 个 姓名 ， 则 认为 是 重复 记录 ， 就 把 该 行 设置 为 红色 。 

第 一 个 循环 体 结束 后 ， 所 有 重复 记录 都 加 上 了 红色 ， 如 图 7-10 所 示 。 

为 了 删除 这 些 加 了 颜色 的 单元 格 , 需要 用 倒序 删除 ， 只 要 是 红色 的 单元 格 区 域 就 删除 。 
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最 后 结果 如 图 7-11 所 示 。 


E 
D12 -| x 
4| & B 9 D 
1 | 姓名 语文 “数学 英语 
2 | 赵 六 81 90 82 
3 _| 李 四 80 98 61 
生 | 大 龙 70 64 67 
5 | 王 五 78 98 82 
6 小 虎 98 87 78 
1 

图 7-10 重复 记录 自动 标记 为 红色 图 7-11 删除 所 有 填充 色 为 红色 的 行 


7.2.3 ”检查 字符 串 中 是 否 有 重复 字符 


某 些 场合 需要 判断 一 个 字符 串 中 的 每 个 字符 是 不 是 唯一 的 ， 是 否 有 出 现 两 次 以 上 的 情 
况 。 例 如 “Condition” 这 个 单词 中 , i 和 o 都 出 现 了 多 次 ， 而 “ Friend” 这 个 单词 无 重复 情 
况 。 下 面 的 过 程 把 字符 串 中 的 每 个 字符 作为 字典 的 键 添加 到 字典 中 ， 如 果 有 重复 字符 ,字典 
的 键 值 对 个 数 一 定 小 于 字符 串 的 长 度 ， 利 用 这 个 特征 进行 判断 。 

Sub 检查 是 否 有 重复 字符 () 


Const s As String = "Microsoft" 

Dim dic As New Dictionary 

Dim i As Integer 

For i = 1 To Len(s) 
dic.Item(Mid(s，i，1)) = "" 

Next i 

If dic.Count < Len(s) Then 
MsgBox "有 重复 字符 " 

Else 
MsgBox " 无 重复 字符 " 

End If 

End Sub 


运行 以 上 过 程 ， 对 话 框 显示 “有 重复 字符 ”。 
以 上 内 容 的 源 代码 文件 为 “实例 文档 44.xlsm”。 


7.3 本章 小 结 


字典 的 结构 类 似 于 一 个 多 行 、2 列 的 二 维 数组 ， 由 于 第 一 列 是 不 重复 的 ， 因 此 可 以 方便 
地 通过 第 一 列 访问 到 第 二 列 ， 不 使 用 循环 结构 就 能 通过 键 找到 对 应 的 值 。 
字典 对 象 的 Exists 方法 可 以 判断 字典 中 是 否 存在 某 个 键 ， 这 些 都 是 数组 不 具备 的 性 能 。 
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站 操作 数据 库 


数据 库 (Database) 是 存储 数据 的 容器 。 对 于 大 中 型 应 用 程序 和 软件 的 开发 ， 一 般 都 需 
要 利用 数据 库 来 保存 数据 、 维 护 数据 和 读 出 数据 ， 如 果 程 序 中 用 到 的 数据 量 不 大 ， 可 以 考虑 
利用 系统 的 注册 表 作为 数据 容器 ， 也 可 以 考虑 使 用 外 部 文本 文件 ， 但 如 果 软 件 中 有 大 量 的 数 
据 进出 ， 使 用 数据 库 更 为 专业 。 
目前 数据 库 有 很 多 种 格式 ， 常 见 的 主要 有 微软 公司 的 Microsoft SQL Server 、Access 等 ， 
另外 Excel 文件 、CSV 文件 和 文本 文件 也 可 以 用 作 数 据 库 。 
数据 库 在 使 用 方面 ， 一 般 分 为 手工 操作 和 使 用 代码 访问 两 种 方式 。 本 章 首先 简单 演示 一 
下 手工 在 Access 2013 中 创建 和 维护 数据 库 的 方法 ， 然 后 介绍 使 用 ADO 技术 对 数据 库 进 行 
SQL 查询 。 
利用 代码 访问 数据 库 的 方式 有 很 多 种 ， 但 是 ADO ( ActiveX Data Objects) 是 微软 公司 
推出 的 一 种 数据 访问 技术 ， 优 点 是 易于 使 用 、 速 度 快 、 占 用 磁盘 空间 小 。 而 SQL (Structured 
Query Language) 是 访问 和 处 理 数据 库 的 标准 语言 ， 仅 仅 使 用 一 个 文本 字符 串 就 可 以 对 数据 
库 、 表 进行 复杂 的 访问 和 修改 操作 。 
本 章 用 到 的 外 部 引用 和 重要 对 象 : 
口 Microsoft ActiveX Data Objects 2.8 Library 
> ADODB.Connection 
> ADODB.Recordset 


8.1 Access 数据库 概述 


Access 数据 库 是 存储 于 磁盘 中 的 一 个 扩展 名 为 .accdb 或 mdb ( Access 2003 ) 的 文件 。 
要 用 VBA+ADO 技术 操作 和 访问 数据 库 ， 需 要 事先 创建 数据 库 作 为 被 操作 的 原料 ， 因 此 下 
面 介绍 用 Access 2013 手工 创建 数据 库 的 方法 。 

启动 Access 2013 后 ,依次 单 击 【 文件 /新 建 /空白 桌面 数据 库 】。 
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在 弹出 的 路 径 输入 对 话 框 中 ， 单 击 右 侧 的 “打开 ”按钮 ， 可 以 弹出 “文件 新 建 数据 库 ” 
对 话 框 ， 改 变 到 自己 常用 的 文件 夹 ， 并 且 输 入 数据 库 的 名 称 ChinaProvince.accdb， 如 图 8-1 
所 示 。 该 数据 库 用 来 存储 中 国 各 省 份 信息 。 


nceace 


EVOiceVBA 开 发 好 各 \Ofice VBA 开 入 好 多 
四 人 二 (党 作 数 冯 启 \ 


| 识 有 与 家 条 4 


品 第 4 步 


ID » 


图 8-1 创建 新 数据 库 


单 击 “ 确 定 ” 按 钮 ， 并 且 单 击 “创建 ”按钮 ， 即 可 在 磁盘 文件 夹 中 看 到 该 数据 库 ， 如 
图 8-2 所 示 。 


LE | 


|€ .© EE ，oficevaAFREA ，ofice vBAFFAE 内 中 qh 关 天 K 囊 ， 报 人 BE 放 


组 织 ” 。 包 全 到 库 中 ” 。 共享 ” 新建 文件 闪 

六 修改 日期 
及 下载 
困 点 


2018/2/22 9:32 
2018/2/22 9:32 


图 8-2 数据 库 文件 和 临时 文件 


需要 注意 的 是 ， 当 数据 库 处 于 打开 状态 ,或 者 正在 被 程序 访问 ,会 在 数据 库 文件 夹 中 产 
生 一 个 扩展 名 为 laccdb 的 临时 文件 ， 这 个 文件 一 旦 产生 ， 就 表示 该 数据 库 不 可 以 进行 重 命 
名 或 删除 操作 ， 因 为 数据 库 处 于 打开 状态 。 

对 于 新 创建 的 空白 数据 库 ， 其 中 没有 任何 数据 表 对 象 。 

一 个 数据 库 由 查询 、 表 、 窗 体 等 多 种 对 象 构 成 ， 但 是 表 ( Table) 是 最 常用 的 数据 存储 单 
位 ， 表 从 结构 上 非常 类 似 于 Excel 中 的 二 维 表格 数据 。 

一 个 数据 库 可 以 包含 1 个 以 上 的 表 ， 每 个 表 有 一 个 名 称 来 唯一 识别 。 


8.1.1 数据 表 设 计 


重新 打开 ChinaProvince 数据 库 ， 单 击 功能 区 的 【 创建 /表格 / 表 设计 ]， 弹 出 一 个 “ 表 
1” 的 设计 窗 格 ， 如 图 8-3 所 示 。 


更 office VBA 开发 经 典 -一 中 级 进 阶 卷 


Er VBA 放 三 二 生 汉 从 和 人 沿 是 人 ax 
= | se | ,ea aasra wa。 时 | 
Em EE 局 | Ee 

昌国 /四 风 导 | 匡 辐 口 Bew 利加 口 有 ew De 

各所 | 雪 | 可 全 tsharePont 栖身 呈 可 Crr | 盏 虹 到 人 it 三星 ts 

部 和 污 入 ED 人 as 

入 二 EE 3 3 交 S ~ 
书生 

所 有 Access 对 象 hl EE2 区 
FF 万 字 银 名 许 数据 类 型 说 明 (可 选 ) 日 
I 
E23 


闻 委 名称 量 长 可 到 64 个 字 泊 (和 天 格 ). 控 
月 刍 可 生 看 有 关 字 除名 的 亲 助 ， 


图 8-3 表 的 设计 视图 


实际 上 ,“ 表 1” 是 默认 的 命名 方式 ， 当 没有 保存 时 ， 该 表 还 没有 真正 存储 在 数据 库 中 ， 
因此 接 下 来 输入 该 表 的 所 需 字 段 名 称 (Field Name) 和 字段 类 型 (Field Type)。 


默认 的 字段 类 型 都 是 文本 ， 但 是 本 实例 中 的 面积 、 人 口 字段 是 数字 ， 如 果 要 详细 设 定数 
字 格 式 ， 可 以 单 击 下 面 的 窗 格 。 


另外 ， 还 有 一 个 少数 民族 自治 区 字段 ， 它 是 一 个 布尔 类 型 。 


字段 设 定好 后 ， 单 击 右 上 角 的 x 关闭 设计 视图 ， 此 时 会 弹出 一 个 “另存 为 ”对 话 框 ， 


如 图 8-4 所 示 。 
EETNN [x 
| ”数据 : 说 明 ( 可 和 于》 日 
省 便 用 称 短文 本 
简称 短文 本 
省 会 短文 本 
_| 区 域 短文 本 
和 孝 字 单位 : 万 平方 公里 
字 位 : 万 人 
人 RE 是 / 否 
Weal 
格式 EE3 
标题 
默认 什 No 
验证 规则 
的 元 #! 可 还 的 。 记 于 才 助 沈 肖 该 字段 ,而 
Za 3 2 
且 . 
图 8-4 保存 表 
在 “另存 为 ”对 话 框 中 输入 表 的 名 称 : Detail， 单 击 “ 确 定 ”按钮 ， 此 时 该 表 才 真正 保 
存 于 数据 库 中 。 


表 的 结构 设计 好 了 ， 但 是 真正 的 数据 还 没有 输入 ,在 左 侧 “ 所 有 Access 对 象 ” 窗 格 中 
右 击 Detail 表 ， 在 弹出 菜单 中 选择 “打开 ”命令 ， 就 可 以 像 在 Excel 单元 格 中 一 样 输入 记录 
(Record) 了 ， 如 图 8-5 所 示 。 
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I Sr rs 
所 有 Access 对 象 LE Cl 
E33 省 份 名 称 -| 简称 -| 省 会 - 面积 -| 人 口 -| 少数 氏族 自 ~ 
Pl# 6 6 
二 
Detail 一 一 
BO 
RD) 
SAMW 
SH 
友 二 $s(M) 
在 此 弗 中 隐藏 (Hb 
出 除 ) 
¥% uD 
[人 


图 8-5 打开 表 


提示 “如果 单 击 右键 菜单 中 的 “设计 视图 ”命令 ， 则 可 以 再 次 对 表 结 构 进行 调整 。 


8.1.2 ”字段 类 型 


Access 常用 字段 类 型 和 存储 数据 的 种 类 如 下 。 
口 文 本 : 简短 文本 。 


口 数字 : 一 般 数 字 。 
口 日 期 /时 间 。 
口 货币 。 


口 自动 编号 : 从 1 开始 的 自动 编号 ， 类似 于 Excel 中 的 行 号 ， 唯 一 不 重复 。 


口 是 / 和 否 : 布尔 型 。 
口 备注 : 用 于 存储 比较 长 的 、 多 行文 本 等 。 


一 定 要 记 住 : Access 数据 表 和 Excel 工作 表 不 一 样 ， 一 个 字段 就 是 一 个 列 ， 该 列 输入 的 
数据 必须 和 规定 的 数据 类 型 匹配 ， 例 如 在 人 口 列 中 输入 “三 千 二 百 ”， 就 会 被 拒绝 ， 类 似 于 


Excel 中 的 有 效 性 验证 。 


8.1.3 ”记录 维护 


数据 表 的 打开 视图 中 显示 了 当前 表 中 所 有 的 记录 ， 如 果 某 个 数据 不 确定 是 多 少 ， 可 以 保 
持 空白 (Null)。 例 如 ， 河 北 的 面积 、 安 徽 的 人 口 、 上 海 的 简称 和 区 域 、 江 西 的 省 会 ， 这 5 个 


单元 格 尚未 填写 ， 如 图 8-6 所 示 。 


数据 表 左 下 角 有 个 导航 工具 ， 显 示 表 中 有 34 个 省 、 自 治 区 或 直辖 市 的 信息 ， 当 前 所 
选 为 第 6 项 ， 单 击 旁 边 的 几 个 箭头 按钮 ， 可 以 快速 定位 到 前 一 条 、 后 一 条 、 第 一 条 和 最 末 


一 条 ， 以 及 新 建 记录 。 
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习 Detail 
省 份 名 称 -| 简称 -| 省 会 -| 区 域 -| 面积 -| 人 口 -| 少数 民族 E- 
黑龙 江 黑 哈尔滨 东北 45. 48 3813 
吉 吉 长 春 东北 18.74 2699 
辽宁 辽 沈阳 东北 15.59 4203 
本 5 a 1.68 1423 
天 字 北 113 1007 
河北 蓝 石家庄 。 华北 CC J 
山西 得 太原 华北 15.63 3294 
内 蒙古 蒙 呼和浩特 。 华北 118.3 2379 加 
| 山东 鲁 济南 华东 15.38 9082 
江苏 苏 南京 华东 10.26 7381 
安徽 皖 全 | 华东 13.97 四 
上 海 上 海 63 1625 
浙江 浙 杭州 华东 10.2 4647 
江西 藉 华东 16.7 4222 四 
福建 图 福州 华东 12.13 3466 
河南 瑰 郑州 华中 16.7 9768 四 
湖北 社 武汉 华中 18.59 5988 
湖南 湘 长 沙 华中 21.18 6629 
国 广 东 黑 广州 华南 18 7859 
广西 桂 南宁 华南 23.6 4822 
海南 省 琼 海口 华南 3.4 803 
香港 湛 香港 华南 11 686 四 
澳门 澳 澳门 华南 025 44 固 
台湾 台 台湾 华南 3.6 227 加 
四 咱 川 .时 成 都 西南 48.14 8673 四 
云南 云 、 汗 昆明 西南 38.33 4333 加 
贯 州 员 、 黑 贵阳 西南 17.6 3837 四 
重庆 渝 重庆 西南 8.23 3107 回 
记 台 WH ，| 第 6 项 共 34 项 ，》M MY 下 ET 到 


图 8-6 ”数据 记录 中 允许 空白 


此 次 就 创建 好 了 一 个 表 ， 根 据 业 务 需要 还 可 以 向 数据 库 中 增加 多 个 表 。 同 时 ，Access 
与 Excel 兼容 性 非常 好 ， 可 以 很 方便 地 把 Excel 中 的 数据 表 批 量 导入 Access 数据 库 中 ， 也 可 
以 把 Access 数据 表 导 出 到 Excel 工作 表 中 。 


8.2 ”使 用 ADO 对 象 操作 数据 库 


ADO 是 系统 中 用 来 让 其 他 程序 、 语 言 访问 数据 库 的 一 个 对 象 库 ， 本 身 不 属于 VBA 中 的 
对 象 。 因 此 需要 向 VBA 工程 中 添加 外 部 引用 “ Microsoft ActiveX Data Objects 2.8 Library ”， 
如 图 8-7 所 示 。 


引用 - VBAProject E> 
可 使 用 的 引用 ON: | 
取消 


Visual Basic For Applications 医 
Girosoft Exeel 15.0 Object Librar 


MMOLE Automation 
i i 浏览 四 


+ 

Hyeeroject 局 
YBAProject 先 级 

DANMCPl ayEngine 帮助 00 

口 AeeessibilityCplAdnin 1.0 Type Liby + 

DAecountProtect 1.0 Type Library 


DAcrobat 
DAcrobat Access 3.0 Type Library ~ 


| orohat Nictilleor 
‘lie ; | 
Microsoft ActiveX Data Objects 2.8 Library- 


定位 :C:\Program Files\Conmon Files\Systen\ado\nsado28. 1 
语言 : 标准 


图 8-7 添加 外 部 引用 
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添加 引用 后 ， 在 对 象 浏览 器 中 依次 输入 ADODB 、Connection 并 按 回 车 键 ， 可 以 看 到 
ADODB 对 象 库 中 包含 的 所 有 成 员 ， 如 图 8-8 所 示 。 


PE 
Fe A 


加 
四 
四 
Ea 
加 
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EA 
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“Connection” 的 成 员 
tt 


Version 
sq BeginTrans 
A Cancel 


A Close 
es ComnitTrans 
A Execute 


(ap AtfectEaon sq Open 
[ap BoolmarkErum OpenSchens 
(oP ComnandTypeEnum = | Eollbackfrans 


Property ConnectionString As String 
AD0DB Lonnsction 的 缺 省 成 员 


图 8-8 ADODB 对 象 库 的 成 员 


编程 过 程 中 比较 常用 的 成 员 如 下 。 新 建 Connection 对 象 ， 设 置 其 ConnectionString | 
口 数据 库 连接 对 象 Connection。 

口 记录 结果 集 RecordSet。 打开 Connection， 判 断 是 否 成 功 连接 到 数据 库 
口 命令 执行 对 象 Command。 [ves 

口 字段 对 象 Field。 新 建 RecordSet 对 象 | 
口 属性 对 象 Property。 


了 
其 中 Field 是 RecordSet 的 成 员 对 象 ， 表 基于 Connection 执 行 SQL 查询 


示 记 录 集 中 的 字段 。Property 是 Connection 的 


= 
成 员 对 象 ， 表 示 数 据 库 连接 对 象 的 属性 。 查询 结果 返回 给 RecordSet， 并 复制 结果 到 外 部 | 
使 用 ADO 查询 数据 库 中 表 的 数据 的 一 般 | 
流程 如 图 8-9 所 示 。 关闭 RecordSet | 
1 
8.2.1 Connection 对 象 关闭 Connection， 断 开 与 数据 库 的 连接 | 
Connection 对 象 是 ADO 连接 并 访问 数据 库 图 8-9 数据库 查询 的 一 般 流 程 


的 桥梁 。 它 的 ConnectionString 属性 是 一 个 文本 字符 串 ， 用 来 规定 它 如 何 连 接 到 数据 库 ; 它 的 
State 属性 可 以 判断 是 否 连 接 成 功 ; 它 的 Properties 成 员 可 以 列举 其 连接 数据 库 的 各 项 属性 。 
Connection 对 象 的 Open 方法 用 来 连接 数据 库 ，Close 方法 关闭 数据 库 的 连接 ，Execute 
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方法 用 来 执行 一 个 SQL 查询 并 返回 RecordSet。 
下 面 的 VBA 过 程 使 用 ADO 连接 与 工作 短 在 同一 路 径 下 的 ChinaProvince 数据 库 。 


Public cnn As ADODB.Connection, rst As ADODB.Recordset, pro Rs ADODB.Property, 
fd As ADODB .Field 
Sub 连接 Access 数据 库 () 
Set cnn = New ADODB.Connection 
With cnn 
-ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinapProvince.accdb;Persist Security Info=False;" 
For Each pro In .Properties 
Debug.Print pro.Name，pro.Value ' 谢 历 Connection 对 象 的 各 个 属性 名 和 值 
Next pro 
.Open 
IE .State = ADODB.ObjectStateEnum.adStateOpen Then 
MsgBox " 成 功 连 接 到 数据 库 ! "，vbInformation 
.Close ' 只 有 处 于 打开 的 Connection, 才能 执行 Close 
Else 
MsgBox " 失败 ! "，vbExclamation 
End If 
End With 
End Sub 


代码 分 析 : 连接 数据 库 成 功 与 否 主 要 取决 于 ConnectionString 的 构造 ， 该 连接 字符 串 的 
语法 构成 如 下 。 

"属性 1= 值 1; 属性 2= 值 2;" 

Provider 规定 了 连接 对 象 的 提供 者 是 MicrosoftACE.OLEDB.12.0， 对 于 连接 Access 
2003 数据 库 或 者 其 他 种 类 的 数据 库 ， 此 处 需要 修改 。 

Data Source 规定 了 数据 库 在 磁盘 中 的 位 置 。 

Persist Security Info 表示 连接 成 功 后 是 否 保存 安全 信息 ， 默 认为 False。 

运行 上 述 过 程 后 ， 正 常情 况 下 会 提示 “成 功 连接 到 数据 库 !”， 如 图 8-10 所 示 。 

需要 注意 的 是 ， 无 论 是 Connection 对 象 ， 还 是 后 面 要 讲 的 RecordSet 对 象 ， 只 有 对 象 处 
于 Open 状态 才能 执行 Close 方法 。 同 样 ， 只 有 对 象 处 于 Close 状态 ， 才 能 再 次 Open 对 象 。 

如 果 要 执行 SQL 查询 ， 就 是 在 Connection 处 于 Open 状态 ，Close 方法 执行 之 前 进行 。 

如 果 ConnectionString 的 构造 有 问题 ， 则 会 在 执行 cnn.Open 那 句 时 出 错 ， 如 图 8-11 
所 示 。 

Microsoft Excel EE Microsoft Visual Basic 

运行 时 错误 ，-2147467259 (Bo004005) 


“PE: VDfficeyBA 开 发 经 典 \Dffice VBA 开发 经 典 . 中 
代码 时 \ChinaProvine. accdb’ 。 


结束 中 | [ER 帮助 吕 


一 一 


图 8-10 ”连接 到 数据 库 图 8-11 连接 失败 


此 时 ， 应 该 根据 错误 提示 找到 出 错 原因 ， 修 改 代 码 后 重新 运行 。 
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8.2.2 RecordSet 对 象 


RecordSet 是 执行 SQL 查询 后 形成 的 结果 记录 集 ， 也 就 是 过 滤 筛 选 后 生成 的 子 数 
据 表 。 

例如 从 ChinaProvince 数据 库 的 Detail 表 中 找 出 中 国 5 个 少数 民族 自治 区 的 省 份 名 称 、 
省 会 、 区 域 信 息 ， 就 需要 构造 如 下 SQL 查询 语句 。 


Select 省 份 名 称 ， 省 会 ， 区 域 From Detail Where 少数 民族 自治 区 =True 


已 打开 的 Connection 对 象 执行 该 查询 语句 后 就 形成 了 一 个 子 表 ， 如 图 8-12 所 示 。 

以 上 这 个 结果 表 的 信息 ， 通 过 RecordSet 对 象 来 下 
访问 。 

下 面 的 代码 在 上 一 个 VBA 程序 基础 上 修改 ， 具 体 
实施 查询 过 程 。 


Public cnn As ADODB.Connection, rst Rs ADODB. 图 8-12 SQL 查询 产生 的 结果 记录 和 集 
Recordset, pro As ADODB.Property, fld As ADODB.Field 
Sub 查询 Access 数据 库 () 
Set cnn = New ADODB.Connection 
With cnn 
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 
IE .State = ADODB.ObjectStateEnum.adStateOpen Then 
Set rst = New ADODB.Recordset 
rst.CursorLocation = adUseClient 
rst.Open Source:="Select 省 份 名 称 ， 省 会 ， 区域 From Detail Where 少数 民 
族 自治 区 =True"，ActiveConnection:=cnn, CursorType:=ADODB.CursorTypeEnum.adOpenKeyset, 
LockType:=ADODB.LockTypeEnum.adLockOptimistic 
If rst.State = ADODB.ObjectStateEnum.adStateOpen Then 
Debug.Print "结果 记录 集 的 记录 总 数 : "，rst.RecordCount 
ActiveSheet.Range ("A2") .CopyFromRecordset rst 
rst.Close ' 关 闭 rst 


End If 
.Close ' 关闭 cnn 
Else 
MsgBox " 失败! "，vbExclamation 
End If 
End With 


Set rst = Nothing 
Set cnn = Nothing 
End sub 


代码 分 析 : 执行 SQL 查询 的 核心 代码 是 rst.Open 那 一 句 ，RecordSet 的 Open 方法 中 通 
常 包 含 4 个 参数 ， 其 中 Source 参数 需要 规定 一 个 SQL 查询 语句 ，ActiveConnection 需要 设 
置 为 当前 数据 库 连 接 对 象 ， 后 面 两 个 参数 分 别 为 游标 类 型 和 锁 类 型 。 

ActiveSheet.Range("A2").CopyFromRecordset rst 用 来 把 生成 的 结果 记录 集 发 送 到 以 A2 
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单元 格 为 左上 角 的 单元 格 区 域 中 ,运行 上 述 过 程 ， 立 即 
窗口 打印 出 记录 集 的 总 数 为 5， 记 录 集 导出 到 Excel 单 
元 格 中 ， 如 图 8-13 所 示 。 

Excel VBA 中 Range 对 象 的 CopyFromRecordset 方 
法 专门 用 来 接收 数据 库 的 结果 记录 集 ， 但 是 该 方法 不 会 
自动 加 上 字段 标题 ， 这 还 需要 遍历 RecordSet 的 Fields 
属性 方 可 。 


8.2.3 Field 对 象 


F10 ur 
-| 
a 

2 内 蒙古 。 呼和浩特 华北 

3 广西 。 南宁 华南 

4 西藏 “拉萨 。 ”西南 

5 新 疆 ”乌鲁木齐 西北 

6 宁夏 银川 ”西北 

7 


图 8-13 查询 结果 直接 发 送 到 单元 格 


一 个 RecordSet 对 象 有 一 个 Fields 字段 集合 成 员 ， 该 集合 表示 结果 记录 集 的 所 有 列 ， 对 
于 上 面 自治 区 查询 的 实例 ，Fields 主要 取决 于 SQL 语句 中 Select 子 句 后 面 列 出 的 字段 名 称 。 


Field 表示 其 中 一 个 字段 ，Field 对 象 有 如 下 三 大 属性 。 


口 Name: 字段 的 名 称 。 


口 Value: 该 字段 的 当前 取 值 ， 与 RecordSet 的 游标 有 关 。 
口 Type: 字段 的 类 型 ， 也 就 是 数据 库 设 计时 的 字段 类 型 。 
下 面 的 代码 段 基 于 上 述 “ 查 询 Access 数据 库 ” 过 程 修改 。 
If rst.State = ADODB.ObjectStateEnum.adStateOpen Then 


Debug .Print " 结果 记录 集 的 记录 总 数 : "，rst.RecordCount 
Debug .Print " 结果 记录 集 的 字段 总 数 : "，rst.Fields.Count 


For Each fld In rst.Fields 


Debug .Print fld.Name, fld.Type, fld.Value 


Next fld 


ActiveSheet.Range ("A2") .CopyFromRecordset rst 


Dim i As Integer 
For i = 0 To rst.Fields.Count - 1 


ActiveSheet.Cells(l1, i + 1).Value = rst.Fields(i).Name 


Next i 
rst.Close ' 关闭 rst 
End If 


代码 分 析 : 当 执 行 SQL 查询 后 ， 根 据 RecordSet 打印 记录 总 数 和 字段 总 数 ， 然 后 遍历 


每 个 字段 的 名 称 、 类 型 和 当前 值 。 


最 后 一 个 For 循环 用 来 把 字段 名 称 加 到 Excel 第 一 行 单元 格 中 ， 如 果 使 用 数字 下 标 遍 历 


Fields， 是 从 0 开始 的 。 


运行 上 述 代码 ，Excel 中 单元 格 的 数据 带 有 标题 行 ， 如 图 8-14 所 示 。 


立即 窗口 的 打印 结果 如 图 8-15 所 示 。 


立即 窗口 中 打印 出 的 “省 份 名 称 ” 是 一 个 字段 的 名 称 ，202 表示 字段 类 型 是 文本 ， 它 是 
一 个 ADODB 内 置 枚 举 常 量 的 等 价 整数 ， 由 于 本 实例 中 3 个 字段 全 是 文本 ， 所 以 打印 出 来 的 
都 是 202。 在 对 象 浏览 器 中 输入 DataTypeEnum 执行 搜索 ， 可 以 看 到 所 有 字段 类 型 的 枚 举 常 


量 ， 如 图 8-16 所 示 。 
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Flo ”| 
| Cc 
国宝 伍 - 区 站 结果 记录 集 的 记录 总 数 : 5 
| 贫 是 记 邓 集 的 字段: 3 
4 | 西藏 。 拉萨 ” ”西南 省 份 名 202 内 蒙古 
5 | 新 疆 ”乌鲁木齐 西北 省 会 202 呼和浩特 
6 | 宁夏 ”银川 西北 区 域 202 华北 
1 间 || 

图 8-14 遍历 字段 并 发 送 到 单元 格 图 8-15 打印 结果 记录 集 的 有 关 信 息 


|p ErrorVal usEnn 
| EventReasonEnun 
NP EventStatusEnun 
ep ExecuteDptionEnun 
Nap FicldhttributeEnun 
geP FieldEnwn 

oP FieldStatusEnun 


NP FilterGroupEnwn 
| ep GethonsOptionEnun 

ap IsolationLevelEnun 

‘a LineSeparatorEnun 

路 LockTypeEnum 国 adyarNumeric 
hat 回 
Jap Movele 

Nm noet 


图 8-16 字段 类 型 常 量 及 其 对 应 的 数值 


在 立即 窗口 中 的 第 3 列 中 ， 可 以 看 到 打印 出 的 记录 是 内 蒙古 的 相关 信息 ， 这 是 为 什么 
呢 ? 能 不 能 打印 出 其 余 4 个 少数 民族 自治 区 的 信息 呢 ? 这 就 涉及 如 何人 遍历 结 果 记 录 集 中 记录 
行 的 问题 了 。 


8.2.4 ”遍历 记录 行 


SQL 中 使 用 Select 子 句 进行 查询 ， 得 到 的 结果 记录 集 是 符合 条 件 的 一 个 子 表 ， 那 么 执 
行 SQL 查询 后 ，RecordSet 对 象 的 默认 游标 处 于 结果 记录 集 的 第 一 条 记录 上 。 

如 果 要 提取 后 面 记录 的 数据 ， 必 须 使 用 Move 系列 的 方法 移动 游标 ， 移 动 游标 后 ， 当 前 
记录 行 (Current Record) 的 位 置 也 随 之 改变 。 

口 MoveFirst: 移动 到 首 条 记录 。 

口 MoveLast: 移动 到 最 末 行 

口 MovePrevious: 移动 到 当前 记录 的 前 一 条 。 

口 MoveNext: 移动 到 当前 记录 的 后 一 条 。 

口 Move: 移动 到 特定 的 位 置 。 
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通过 Move 系列 方法 移动 游标 后 ， 由 于 当前 记录 行 位 置 发 生变 化 ，RecordSet.Fields(i). 
Value 也 会 变化 ， 从 而 实现 提取 不 同 记录 行 的 数据 。 

同时 ， 使 用 Move 系列 方法 时 必须 考虑 是 否 移动 到 结构 记录 集 的 边界 ， 如 果 当 前 记 
录 是 记录 和 集 的 首 条 ， 那么 再 执行 MovePrevious 方法 后 ， 游 标 被 移动 到 记录 集 以 外 ， 此 时 
RecordSet 的 BOF 属性 为 True ; 同 理 ， 如 果 当 前 记录 是 记录 集 的 最 后 一 条 ,那么 再 执行 
MoveNext 方法 后 ， 游 标 也 被 移动 到 记录 集 以 外 ， 此 时 RecordSet 的 EOF 属性 为 True。 

因此 ， 经 常 利用 EOF 属性 配合 Do...Loop 循环 来 遍历 所 有 记录 行 。 


Sub 移动 游标 () 
Dim mark Rs ADODB .BookmarkEnum 
Set cnn = New ADODB.Connection 


With cnn 
.Connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 


IE .State = ADODB.ObjectStateEnum.adStateOpen Then 

Set rst = New ADODB.Recordset 

rst.CursorLocation = adUseClient 

rst.Open Source:="Select 省 份 名 称 ， 省 会 ,区 域 From Detail Where 少数 民 

族 自治 区 =True"，ActiveConnection:=cnn, CursorType:=ADODB.CursorTypeEnum.adopenKeyset, 
LockType:=ADODB .LockTypeEnum.adLockOptimistic 

IE rst.State = ADODB.ObjectStateEnum.adStateOpen Then 
Debug .Print "结果 记录 集 的 记录 总 数 : "，rst.RecordCount 
Debug .Print "结果 记录 集 的 字段 总 数 : "，rst.Fields.Count 
rst.MoveFirst ' 第 一 条 
Debug.Print rst.Fields (" 省 会 ") .Value，rst.Fields(" 省 份 名 称 ") .Value 
rst.MoveNext ' 第 二 条 
Debug.Print rst.Fields(" 省 会 ") .Value，rst.Fields(" 省 份 名 称 ") .Value 
rst.MoveLast ' 最 后 一 条 (第 5 条 ) 
mark = rst.Bookmark 
Debug.Print rst.Fields(" 省 会 ") .Value，rst.Fields (" 省 份 名 称 ") .Value 
rst.MovePrevious ' 前 一 条 (第 4 条 ) 
Debug.Print rst.Fields(" 省 会 ") .Value，rst.Fields(" 省 份 名 称 ") .Value 
rst.Move NumRecords:=-2, Start:=ADODB.BookmarkEnum.adBookmarkLast 
Debug.Print rst.Fields(" 省 会 ") .Value，rst.Fields(" 省 份 名 称 ") .Value 
rst.Close ' 关 闭 rst 


End If 
.Close ' 关闭 cnn 
Else 
MsgBox " 失败! "，vbExclamation 
End If 
End With 


Set rst = Nothing 
Set cnn = Nothing 
End Sub 


代码 分 析 : 无 论 是 否 使 用 Move 系列 方法 ，RecordSet 都 是 一 个 不 变 的 子 表 ,使 用 Move 
系列 方法 主要 是 改变 RecordSet 的 当前 活动 行 。 

Move 系列 方法 中 最 难 理解 的 是 Move。 该 方法 可 以 设置 两 个 参数 ， 第 一 个 参数 
NumRecords 接受 一 个 长 整 型 的 数字 ， 表示 从 参照 行 引起 的 偏 黎 ， 可 以 是 正 数 或 负数 。 第 二 
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个 参数 Start 接受 一 个 枚 举 常量 ， 用 来 设置 参照 行 。 
rst.Move NumRecords:=-2, Start:=ADODB.BookmarkEnum.adBookmarkLast 


这 行 代码 表示 ， 以 最 末 一 行为 参照 ，-2 


示 向 上 移动 2 行 ， 那 曾 动 到 “西藏 ” 结果 记录 集 的 记录 总 数 : 5 
表示 向 上 移 到 2 行 ， 那 就 是 移 到 到 “本 藏 ”| 等 条 这 及 集 的 李 役 总数 : 3 
那 一 行 。 运 行 上 述 过 程 ， 立 即 窗 口 的 结果 如 呈 和 洛 竺 内 这 

宁 本 

图 8-17 所 示 。 银川 宁夏 

另外 ，Start 参数 除了 使 用 内 置 枚 举 常量 乌鲁木齐 新 疆 

外 ， 还 可 以 用 RecordSet 的 Bookmark 属性 作 拉 闻 西藏 
为 参照 起 始 行 。 图 8-17 游标 的 移动 


rst.Move NumRecords:=-2, Start:=mark 


其 中 mark 变量 是 之 前 计算 出 的 一 个 书签 值 。 
如 果 要 按 正常 顺序 打印 结果 记录 集 ， 一 直 使 用 MoveNext 方 法 即 可 。 下 面 的 过 程 分 别 使 
用 For 循环 和 Do...Loop 循环 正 序 打印 每 条 记录 。 


Sub 遍历 记录 行 () 
Dim i As Integer 
Set cnn = New ADODB.Connection 
With cnn 
.Connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 
IE .State = ADODB.ObjectStateEnum.adStateOpen Then 
Set rst = New ADODB.Recordset 
rst.CursorLocation = adUseClient 
rst.Open Source:="Select 省 份 名 称 ， 省 会 ， 区 域 From Detail Where 少数 民 
族 自 治 区 =True"， ActiveConnection:=cnn, CursorType:=ADODB.CursorTypeEnum.adopenKeyset, 
LockType:=ADODB .LockTypeEnum.adLockOptimistic 
IE rst.State = ADODB.ObjectStateEnum.adStateOpen Then 
rst.MoveFirst 
For i = 1 To rst.RecordCount 
Debug.Print rst.Fields(" 省 份 名 称 ") .Value 
rst.MoveNext 
Next i 
rst.MoveFirst 
Do Until rst.EOF 
Debug.Print rst.Fields(1) .Value 
rst.MoveNext 
Loop 
rst.Close ' 关 闭 rst 
End If 
-Close ' 关闭 cnn 
Else 
MsgBox " 失败! "，vbExclamation 
End If 
End With 
Set rst = Nothing 
Set cnn = Nothing 
End Sub 
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需要 注意 的 是 ， 不 管 是 哪 一 种 循环 方式 ， 循 环 之 前 请 把 游标 移动 到 第 一 行 。 在 使 用 
Do...Loop 循环 结构 时 ， 循 环 体内 部 必须 有 RecordSetMoveNext 语句 ， 和 否则 当前 记录 行 固 定 
在 同一 个 位 置 ， 使 得 EOF 属性 一 直 是 False， 陷 入 死 循环 。 


8.2.5 使 用 Connection.Execute 方法 执行 SQL 语句 


SQL 查询 中 ，Select 子 句 从 数据 库 中 查询 出 符合 条 件 的 记录 ， 形 成 结果 记录 集 ， 并 不 破 
坏 原 数据 表 的 数据 。 

还 有 一 些 子 句 ， 例 如 Insert Into、Delete、Update 子 句 的 作用 和 目的 并 非 查询 ， 而 是 
对 数据 库 中 原 数 据 表 的 增加 、 删 除 和 修改 更 新 操作 ， 此 时 不 需要 返回 结果 记录 集 。 也 就 
是 说 ， 操 作 数据 库 的 目的 不 是 查询 ， 而 是 修改 原 表 ， 无 须 使 用 RecordSet 对 象 ， 仅 仅 使 用 
Connection 对 象 的 Execute 方法 即 可 执行 SQL 语句 。 

下 面 的 过 程 将 删除 数据 表 Detail 中 省 会 为 空 的 记录 整 行 。 

Sub Execute 方法 查询 Rccess 数据 库 () 


Set cnn = New RDODB.Connection 


With cnn 
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 


If .State = ADODB.ObjectStateEnum.adStateOpen Then 
.Execute CommandText:="Delete From Detail Where 省 会 Is Null" 
MsgBox " 成 功 执 行 SQL 语句 。"， vbInformation 
.Close ' 关闭 cnn。 


Else 
MsgBox " 失败 ! "，vbExclamation 
End If 
End With 
Set cnn = Nothing 


End Sub 


执行 上 述 过 程 后 ， 在 Access 中 再 次 打开 数据 库 ChinaProvince， 可 以 看 到 表 Detail 中 省 
会 为 空白 的 记录 被 删除 。 
因此 ， 在 实际 编程 过 程 中 ， 要 根据 执行 SQL 的 目的 来 决定 是 否 使 用 RecordSet 对 象 。 


8.2.6 ”使 用 Command.Execute 方法 执行 SQL 语句 


Command 对 象 也 有 一 个 Execute 方 法 用 于 执行 SQL 语句 ， 使 用 Command 对 象 之 前 ， 
先 创 建 一 个 Connection 对 象 ， 当 Connection 对 象 正 常 Open 之 后 ， 让 Command 对象 的 
ActiveConnection 属性 等 于 这 个 Connection 对 象 即 可 。 

下 面 的 过 程 使 用 Command 对 象 执行 删除 查询 。 


Sub Command 方法 查询 Rccess 数据 库 () 
Dim cmd As ADODB.Command 
Set cnn = New ADODB.Connection 
Set cmd = New ADODB.Command 
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With cnn 
-ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 
Set cmd.ActiveConnection = cnn 
IE .State = ADODB.ObjectstateEnum.adStateOpen Then 
cmd.CommandType = adCmdText 
cmd.CommandText = "Delete From Detail Where 区 域 =' 华北 '" 
cmd.Execute ' 删除 区 域 为 华北 的 所 有 记录 
.Close ' 关闭 cnn 
End If 
End With 
Set cnn = Nothing 
End Sub 


8.3 窗 体 中 显示 查询 结果 


通过 SQL 中 的 Select 子 句 得 到 的 结果 记录 集 ， 可 以 发 送 到 Excel 单元 格 区 域 ， 也 可 以 
遍历 记录 行 ， 把 每 行 记录 的 信息 打印 到 立即 窗口 。 在 实际 开发 过 程 中 ， 数 据 查 询 的 结果 经 常 
显示 于 窗 体 控件 中 。 

在 窗 体 上 呈现 查询 结果 时 ， 既 可 以 一 次 显示 结果 记录 集 的 所 有 行 ， 也 可 以 一 次 只 显示 
一 行 ， 根 据 任务 需要 而 定 ， 如 果 一 次 显示 所 有 记录 ,使 用 ActiveX 控件 中 的 DataGrid 或 者 
MSForms 中 的 ListBox 控件 比较 适合 ， 一 次 显示 一 条 记录 的 情形 ， 使 用 TextBox 即 可 。 


8.3.1 ListBox 控件 显示 结果 记录 集 


下 面 的 实例 在 VBA 窗 体 上 放置 一 个 列表 框 来 显示 人 口 大 于 5000 万 人 的 省 份 。 
VBA 窗 体 上 放置 一 个 TextBox， 用 来 输入 SQL 查询 语句 ， 再 放置 一 个 ListBox， 用 来 显 
示 结 果 记 录 集 。 其 中 文本 框 的 KeyDown 事件 代码 如 下 。 


Private Sub TextBoxl_KeyDown (BYVal KeyCode As MSForms .ReturnInteger， ByVal 
Shift As Integer) 
If KeyCode = vbKeyReturn Then 
Set cnn = New ADODB.Connection 
With cnn 
.Connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 
IE .State = ADODB.ObjectStateEnum.adStateOpen Then 
Set rst = New ADODB.Recordset 
rst.CursorLocation = adUseClient 
rst.Open Source:=Me.TextBox].Text, ActiveConnection:=cnn, CursorType:= 
ADODB .CursorTypeEnum.adOopenKeyset, LockType:=ADODB.LockTypeEnum.adLockOptimistic 
IE rst.State = ADODB.ObjectstateEnum.adStateOpen Then 
Me.ListBoxl.ColumnCount = rst.Fields.Count 
ActiveSheet .UsedRange.ClearContents 
Range ("A2") .CopyFromRecordset rst 
Dim i As Integer 
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For i = 0 To rst.Fields.Count -1 
ActiveSheet.Cells(1, i + 1) .Value = rst.Fields (i).Name 
Next i 
Me.ListBoxl.Column = Application.WorksheetFunction.Transpose 
(Range ("Al") .Resize (rst.RecordCount+1, rst.Fields.Count) .Value) 
rst.Close ' 关 闭 rst 
End If 
.Close ' 关闭 cnn 
End If 
End With 
Set rst = Nothing 
Set cnn = Nothing 
End If 
End sub 


代码 分 析 : 当 在 文本 框 中 按 下 回 车 键 时， 执行 SQL 查询 ， 查 询 结束 后 ， 首 先 把 结果 
记录 集 发 送 至 单元 格 区 域 ， 然 后 设置 列表 框 的 Column 属性 为 Range 即 可 。 需 要 注意 的 是 ， 
Excel 中 的 数据 是 带 有 标题 行 的 ， 也 就 是 数据 条 目 比 结果 记录 和 集 多 1， 因此 向 ListBox 赋值 
的 时 候 ， 通 过 Resize 方法 更 改 区 域 尺寸 为 Range("Al").Resize(rstRecordCount+l, rst.Fields. 
Count).Value。 

启动 窗 体 ， 在 文本 框 中 输入 SQL 查询 语句 ， 按 下 回 车 键 ， 可 以 看 到 列表 框 中 显示 与 单 
元 格 中 显示 内 容 是 完全 一 样 的 ， 如 图 8-18 所 示 。 


4 人 
1 | 省 份 名 称 省 会 人 口 

2 lt 6735 
3 | 山东 济南 9082 
生 | 江苏 南京 7381 
5 | 河南 郑州 9768 
6 湖北 武汉 5988 
7_ 湖南 长 沙 6629 
8_| 广 东 广州 7859 
9 四川 成 者 8673 


图 8-18 VBA 的 列表 框 控件 中 显示 查询 结果 


8.3.2 ”使 用 TextBox 控件 显示 单条 记录 


下 面 的 实例 在 用 户 窗 体 上 放置 6 个 TextBox 和 一 个 CheckBox， 复 选 框 控件 用 于 显示 是 
否 为 少数 民族 自治 区 。 

在 窗 体 右 侧 添 加 4 个 CommandButton 控件 ， 用 来 移动 游标 以 切换 记录 行 。 

最 上 面 的 文本 框 用 来 输入 SQL 语句 并 按 下 回 车 键 进行 执行 ， 具 体 KeyDown 事件 如 下 。 


Private Sub TextBox1l KeyDown (BYVal KeyCode Rs MSForms .ReturnInteger， ByVal 
Shift As Integer) 
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If KeyCode = vbKeyReturn Then 
Set cnn = New ADODB.Connection 
With cnn 
-ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data 
Source=" & ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 
If .State = ADODB.ObjectStateEnum.-adStateOpen Then 
Set rst = New ADODB.Recordset 
rst.CursorLocation = adUseClient 
rst.Open Source:=Me.TextBox]l .Text, ActiveConnection:=cnn, CursorType:= 
ADODB .CursorTypeEnum.adOpenKeyset, LockType:=ADODB.LockTypeEnum.adLockOptimistic 
End If 
End With 
End If 
End Sub 


需要 注意 的 是 ， 由 于 本 实例 需要 经 常 移动 游标 ， 因 此 窗 体 显 示 期 间 不 能 关闭 RecordSet 
和 Connection 对 象 ， 并 且 这 两 个 对 象 要 声明 为 模块 级 变量 。 
接 下 来 为 4 个 导航 按钮 设置 单 击 事件 ， 如 下 所 示 。 


Private Sub CommandButtonl Click() 
' 第 一 条 
rst.MoveFirst 
Call GetData 

End Sub 


Private Sub CommandButton2 Click() 
' 后 一 条 
IE rst.EOF = False Then 
rst.MoveNext 
Call GetData 
End If 

End Sub 


Private Sub CommandButton3 Click() 
' 前 一 条 
If rst.BOF = False Then 
rst.MovePrevious 
Call GetData 
End If 

End Sub 


Private Sub CommandButton4 Click() 
" 最 后 一 条 
rst.MoveLast 
Call GetData 

End sub 


需要 注意 的 是 ，RecordSet 执 行 MoveNext 方 法 时 ,一 定 要 检查 EOF 属性 是 否 为 
True ; MovePrevious 方法 执行 之 前 要 检查 BOF 属性 是 否 为 Tme。 当 游标 成 功 移动 后 ， 调 用 
GetData 过 程 ， 把 记录 集 的 数据 放 和 人 对 应 文本 框 中 。 
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Sub GetData() 
IE rst.BOF Or rst.EOF Then 


Else 
With Me 
.TextBox2.Text = rst.Fields(" 省 份 名 称 ") .Value & "" 
.TextBox3.Text = rst.Fields ("简称 ") .Value & "" 
.TextBox4.Text = rst.Fields(" 省 会 ") .Value & "" 
.TextBox5.Text = rst.Fields(" 区 域 ") .Value & 
.TextBox6.Text = rst.Fields(" 面积 ") .Value & "" 
.TextBox7.Text = rst.Fields("” 人口 ") .Value & " 
.CheckBoxl.Value = rst.Fields ("少数 民族 自治 区 ") .Value & "" 
End With 
End If 
End Sub 


代码 分 析 : 在 使 用 RecordSet 的 Fields 提取 数据 前 ， 需 要 保证 BOF 和 EOF 属性 均 为 
False 才 行 。 当 某 个 字段 的 值 是 Null (数据 为 空白 )， 此 时 访问 其 Value 属性 会 出 错 ， 故 此 后 
面 均 加 上 &""。 

启动 用 户 窗 体 ， 在 最 上 面 的 文本 框 中 输入 SQL 语句 并 按 下 回 车 键 ， 然 后 单 击 “ 最 后 一 
条 ”按钮 ， 左 侧 各 个 文本 框 显示 相应 信息 ， 如 图 8-19 所 示 。 


UserForm2 下 = 
SQL: | Select * From Detail 
一 当前 记录 行 信息 一 一 一 导航 窗 格 
省 份 名 称 ” 『「 夏 | 第 -条 
简称 宁 后 -条 
省 会 EE 
区 域 Ez | 前 -条 
配 EE | 已 
人 口 527 
友 少数 民族 自治 区 


图 8-19 文本 框 中 显示 结果 
以 上 内 容 的 源 代码 文件 为 “实例 文档 45.xlsm”。 


8.3.3 ”使 用 DataGrid 控件 显示 结果 记录 集 


显示 结果 记录 集 最 适合 的 控件 要 数 Microsoft DataGrid Control 6.0， 该 控件 以 表格 的 形 
式 显示 结果 记录 集 ， 并 且 可 以 自动 移动 游标 、 自 动 修改 、 删 除 记录 和 增加 记录 。 

但 是 很 多 情况 下 不 能 向 VBA 的 UserForm 中 插入 DataGrid 控件 ， 因 此 下 面 的 实例 向 
VB6 的 Form 中 添加 一 个 Text 文本 框 和 一 个 DataGrid 控件 。 

DataGrid 控件 不 是 VB6 的 基本 控件 ， 因 此 需要 单 击 VB6 的 菜单 [工程 /部 件 ]， 勾 选 
“Microsoft DataGrid Control 6.0” ， 如 图 8-20 所 示 。 
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DMicrosoft Common Dislog Control 6.0 
DMicrosoft Data Bound List Controls 6.C 
Ea 0 (OLEDE: 
口 miereseft DataList Controls 6.0 (OLEDE| 
口 miereseft DataRepeater Control 6.0 (OL 
口 mwiereseft IDS 80 

DMicrosoft External Item Picker 
ODMicrosoft FlexGrid Control 6.0 
DMicrosoft Forms 2.0 Object Library 
DMicrosoft Help Visuals 1.0 
DMicrosoft Hierarchical FlexGrid Contrc™ 


ee 上 三 只 旺 示 园 定 顺 6) 
Microsoft DataGrid Control 6.0 (OLEDB) 
[ 定位 : EE: \CnChessQipu\MSDATGRD. DCX 
i | 
图 8-20 窗 体 上 添加 DataGrid 控件 


在 窗 体 的 设计 模式 下 ， 可 以 把 DataGrid 控件 从 控件 工具 箱 中 拖 放 到 窗 体 上 。 
窗 体 的 代码 视图 中 ,文本 框 的 KeyDown 事件 用 来 连接 数据 库 、 执 行 查询 并 把 查询 的 结 
果 记 录 集 绑 定 到 DataGrid 控件 。 


Private cnn Rs ADODB.Connection, rst As ADODB.Recordset 
Private Sub Textl] KeyDown (KeyCode Rs Integer, Shift As Integer) 
If KeyCode = vbKeyReturn Then 
Set cnn = New ADODB.Connection 
With cnn 
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= 
" & App.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 
If .State = ADODB.ObjectStateEnum.adStateOpen Then 
Set rst = New ADODB.Recordset 
rst.CursorLocation = adUseClient 
rst.Open Source:=Me.Text].Text, ActiveConnection:=cnn, CursorType:= 
ADODB .CursorTypeEnum.adOopenKeyset, LockType:=ADODB.LockTypeEnum.adLockOptimistic 
With Me.DataGridl 


.AllowAddNew = True " 允许 添加 新 记录 
.AllowDelete = True " 允许 删除 记录 
.AllowUpdate = True " 允许 修改 记录 
Set .DataSource = rst 
End With 
End If 
End With 
End If 
End Sub 


代码 分 析 : 可 以 看 出 ,与 VBA 中 使 用 ADO 唯一 不 同 的 是 With Me.DataGrid 那 4 行 代 
码 ， 前 3 行 用 来 设置 DataGrid 是 否 允许 删除 、 添 加 、 修 改 记录 。 

Set Me.DataGrid.DataSource = rst 这 句 是 关键 ， 作 用 是 把 结果 记录 集 绑 定 到 控件 。 这 也 
是 这 个 表格 控件 能 够 显示 数据 的 原因 。 

启动 窗 体 ， 在 文本 框 中 输入 SQL 语句 ， 并 按 下 回 车 键 ，DataGrid 控件 中 显示 相应 数据 。 
这 样 就 制作 出 了 一 款 SQL 语句 测试 器 ， 如 图 8-21 所 示 。 
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Ds 
[Select * From Detaill 

渍 会 面积 BE 亲 El 
吉林 ”| 下 长 春 FE |18.74 |2699 |0 
辽宁 ”| 辽 沈阳 ”| 东北 |15.59 |4203 |0 
北京 ”| 京 北京 “| 夷 北 “1168 |1423 |0 
天 津津 天 津 “| 华北 |1.13 |1007 |0 
河北 | 芝 石家庄 | 华北 6735 |0 
山西” 晋 太原 E15.63 |3294 0 
内 蒙 囊 | 蒙 呼 和 活 特 | 率 北 ”|118.3 |2379 |- 
山东 | 多 注 南 | 华东 |15.38 |9082 |0 
江苏 | 苏 南京 ”| 华东 |10.26 |7381 |0 
安徽 ”| 院 合肥 ”| 华东 |13.97 0 
上 上海 .63 1625 |0 
浙江 ”| 浙 杭州 “| 罕 东 |102 |4647 |0 
江西 ”| 暮 全 东 |16.7 |4222 |0 
| 福建 “| 头 福 几 ”| 于 东 |12.13 |3466 |0 
河 华中 |16.7 |9768 |0 
SET TvT TE<E- Es 


图 8-21 DataGrid 控件 中 显示 结果 记录 集 
使 用 DataGrid 控件 ， 不 需要 遍历 字段 、 记 录 行 ， 就 可 以 完美 显示 查询 出 的 结果 ， 而 且 
可 以 像 在 Access 中 一 样 通过 DataGrid 控件 编辑 、 修 改 数据 表 。 
以 上 实例 的 VB 工程 源 代码 为 “UseDataGrid.vbp”。 
基于 ADO 技术 进行 数据 库 的 读 写 ， 可 以 制作 很 多 种 应 用 程序 ， 笔 者 以 Access 数据 库 
作为 容器 ,使 用 VB6 结合 DataGrid 控件 制作 了 一 款 象棋 棋谱 浏览 器 ， 可 以 方便 地 存 谱 、 读 
谱 ， 如 图 8-22 所 示 。 


上 本 国 村 
517|* [olwl® olR I 


了 西方 招 圣 胜 上 海 起 玮 
| 十 车 妈 直 和 用 帮 局 之 五 李 义 庆 1965 年 
和 0 员 刘 永 训 


|2BAKAS/4N4/4B4/P8/8P/d4c4/p2rCR3/9/9/2bakab2 b - - 0 35 


图 8-22 VB 联 用 Access 数据 库 制 作 的 软件 
对 本 产品 感 兴趣 的 读者 可 以 从 本 书 配套 资源 下 载 CnChessQipu-Setup-20170427.exe。 
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8.4 SQL 结构 化 查询 语言 详解 


SQL 是 目前 各 种 关系 数据 库 系统 中 广泛 采用 的 标准 语言 ，ADO 对 象 通过 SQL 来 操作 数 
据 库 中 的 数据 。 

前 面 已 经 讲述 过 , ADO 使 用 执行 SQL 查询 的 方法 有 3 个 : Connection 对象 直接 
Execute 的 方法 适合 于 不 需要 返回 结果 记录 集 的 场合 ; RecordSet 的 Open 方法 适合 于 返回 结 
果 记 录 集 ; Command 的 Execute 的 方法 类 似 于 Connection 对 象 。 

实际 上 ， 数 据 库 编程 的 难点 和 重点 在 于 SQL 语句 的 构造 、 理 解 和 运用 上 ， 前 面 已 经 六 
及 使 用 Select 语句 的 简单 用 法 ,但 由 于 SQL 语句 是 一 个 字符 串 ， 书 写 过 程 中 无 任何 语法 提 
示 ， 因 此 本 节 讲 解 查询 语句 最 常用 的 构造 方法 。 

操作 数据 表 中 数据 的 SQL 语句 主要 如 下 。 

口 Select 子 句 : 从 表 中 找到 符合 条 件 的 记录 ， 或 者 对 数据 表 进 行 信息 统计 。 该 子 句 产生 

结果 记录 集 ， 不 破坏 原 数据 表 。 

口 Insert 子 句 : 向 原 数 据 表 中 插入 新 数据 记录 。 

口 Update 子 句 : 修改 原 数据 表 中 特定 的 记录 。 

口 Delete 子 句 : 删除 原 数据 表 中 特定 的 记录 。 

口 Where 子 句 : 配合 以 上 4 个 语句 执行 筛选 。 

此 外 ， 还 有 一 些 用 于 创建 、 修 改 数据 库 、 数 据 表 的 SQL 语句 ， 将 在 8.5 节 讲 解 。 


8.4.1 使 用 Select 语句 查询 


Select 语句 的 作用 是 从 原 数据 表 查 找 符合 特定 条 件 的 记录 ， 并 作为 结果 记录 集 返 回 。 使 
用 Select 语句 可 以 实现 行 的 筛选 、 列 的 筛选 、 记 录 汇 总 、 结 果 记 录 排 序 、 分 类 汇总 等 功能 。 

Select 语句 的 一 般 语 法 如 下 。 

Select 字段 From 表 Where 条 件 


为 了 便于 讲解 ， 此 处 仍然 采用 前 面 的 ChinaProvince 数据 库 ， 以 DataGrid 控件 显示 结 
记录 集 。 


1. 字段 筛选 

所 有 SQL 语句 中 ,字段 名 称 直接 书写 即 可 ， 不 能 用 引号 括 起 来 。Select 后 面 的 字段 列 
表 用 半角 逗号 隔 开 ， 如 果 是 原 数 据 表 中 的 所 有 字段 ， 使 用 * 即 可 。 

查询 出 的 结果 记录 集 ， 一 般 仍 然 保 持原 数据 表 中 的 字段 名 称 ， 当 然 也 可 以 使 用 As 子 名 
改名 。 例 如 下 面 这 句 。 


Select 省 份 名 称 ， 省 会 +' 市 ' Rs Capital, 人 HD Rs Population From Detail 


这 句 SQL 语句 的 功能 是 从 原 数据 表 中 列 出 【省份 名 称 】[ 省 会 】 后面 加 “市 "， 并 且 新 
字段 名 为 Capital、【 人 口 】 的 新 名 称 为 Population。 查 询 结 果 如 图 8-23 所 示 。 
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x 


[Select 省 份 名 称 ， 省 会 + 市 ”As Capital, 人 口 As Population From Detail “~ 


Capital 


Populati 二 
哈 尔 演 市 | 
长春 : 


列 攻 辣 吕 和 国 
BE 


蕊 图 


图 8-23 显示 部 分 字段 
再 次 强调 ， 使 用 Select 子 句 查询 后 ， 返 回 的 是 新 的 结果 记录 集 ， 不 会 损害 到 原 数 据 表 。 
2. 使 用 Distinct 提取 唯一 字段 
数据 表 的 每 列 数据 中 经 常 有 内 容 一 样 的 数据 ， 例 如 要 查看 ChinaProvince 数据 库 中 有 哪 
些 不 同 的 区 域 呢 ? 
下 面 这 名 代码 是 对 【区域 ] 字段 中 的 内 容 进行 去 重 ， 结 果 如 图 8-24 所 示 。 


1 | |select mistinet 区 域 Fron Detail 


回 3 


二 二 二 机 洲 图 
沪 动 融 洲 济 测 


图 8-24 ”显示 某 字 段 的 唯一 值 


Select Distinct 区 域 From Detail 

可 以 看 到 结果 记录 集 共 1 列 ,8 行 (包含 1 个 空白 行 , 这 是 因为 原 数据 表 中 有 的 记录 没 
有 填写 【 区域 ])。 

这 个 去 除 重复 的 功能 看 上 去 类 似 于 第 7 章 讲 过 的 字典 。 

字段 去 重 的 VBA 代码 如 下 。 


Public cnn Rs ADODB.Connection, rst Rs ADODB.Recordset, fld As ADODB.Field 
Sub 字段 去 重 () 

Set cnn = New ADODB.Connection 

With cnn 
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-ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 
.Open 
IE .State = ADODB.ObjectStateEnum.adStateOpen Then 
Set rst = New ADODB.Recordset 
rst.CursorLocation = adUseClient 
Tst.Open Source:="Select Distinct 区 域 From Detail", ActiveConnection:= 
cnn, CursorType:=ADODB.CursorTypeEnum.adOpenKeyset, LockType:=ADODB.LockTypeEnum. 
adLockOptimistic 
IE rst.State = ADODB.ObjectStateEnum.adStateOpen Then 
Debug.Print " 结果 记录 集 的 记录 总 数 : 
Debug.Print " 结果 记录 集 的 字段 总 数 : 
Dim i Rs Integer 
For i = 1 To rst.RecordCount 
Debug.Print rst.Fields ("区域 ") .Value 
rst.MoveNext 


rst.RecordCount 
rst.Fields.Count 


Next i 
rst.Close " 关闭 rst 
End If 
.Close ' 关闭 cnn 
Else 
MsgBox " 失败! "，vbExclamation 
End If 
End With 
Set rst = Nothing 
Set cnn = Nothing 


End Sub 


代码 分 析 : 连接 数据 库 的 过 程 和 以 前 没有 变化 ， 要 
注意 看 的 是 rst.Open 那 句 ， 以 及 使 用 For 循环 打印 记录 
的 那 部 分 。 

运行 上 述 过程 ， 立 即 窗口 打印 出 了 唯一 的 【 区域 )， 
如 图 8-25 所 示 。 


3. 使 用 Top 提取 前 几 条 记录 
下 面 这 句 代 码 从 数据 表 中 选择 前 10 条 ， 结 果 如 图 8-26 所 示 。 


图 8-25 打印 区 域 字段 的 唯一 值 


[su | 到 Top 10 * Fron Detail 


| 曾 称 
EE 


Eb 


图 8-26 查询 前 mn 条 记录 


Select Top 10 * From Detail 
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下 面 这 句 代码 从 数据 表 中 选择 前 10% 的 记录 ， 如 果 原 数据 表 有 34 条 记录 ， 那 么 前 10% 
就 是 前 4 条 记录 ,结果 图 略 , 读者 可 自行 验证 。 


Select Top 10 Percent * From Detail 


8.4.2 ”使 用 Where 子 句 进行 记录 筛选 


利用 Where 子 句 可 以 设 定 条 件 ， 用 来 选择 性 地 筛选 记录 行 。 

Where 子 句 的 难点 是 条 件 表达 式 的 构造 ， 一 般 的 条 件 构造 格式 如 下 。 

Where 字段 比较 运算 符 常量 表达 式 

例如 ，Where 区 域 = 东北 '， 就 是 只 把 【区域 ] 为 东北 的 记录 筛选 出 来 ， 结 果 如 图 8-27 
所 示 。 


En | Pee 省 份 名 称 ,省 会 From Detail Where 区 域 -= 东北" 


| 起 如 工 yt: 
吉林 发 春 
| 辽 了 了 ” 斌 阳 
市 


图 8-27 使 用 Where 作为 筛选 条 件 

SQL 中 的 不 等 于 使 用 二 表示。 例如 ，Where ' 西北 '<> 区 域 ， 表 示 【 区 域 ] 不 是 西北 的 
妮 录 5 

由 于 比较 的 基准 “西北 ”是 一 个 常量 字符 串 ， 因 此 一 定 要 用 单 引 号 括 起 来 。 比 较 基 准 如 
果 是 日 期 ， 要 用 两 个 # 括 起 来 ， 比 较 基 准 是 数字 或 者 是 布尔 常量 ， 则 不 需要 括 起 来 。 

一 些 常用 Where 子 句 如 下 。 

口 大 于 指定 日 期 : Where 出 生日 期 >=#1992/4/6#。 

口 两 门 成 绩 总 和 : Where 语文 + 数学 >=120。 

口 介 于 范围 之 间 : Where 人 口 Between 2000 And 4000。 

口 多 个 数值 之 一 : Where 区 域 mn(' 东北 '" 西北 "西南 )。 

口 数据 为 空 ， Where 省 会 Is Null。 


1. 使 用 And 和 Or 多 条 件 组 合 
Where 子 句 还 允许 使 用 And、Or 进行 多 个 条 件 的 组 合 。 
使 用 And 把 多 个 条 件 连接 起 来 ， 筛 选 出 每 个 条 件 都 成 立 的 记录 。 例 如 : 


Where 面积 >10 And 人 口 <2000 
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把 面积 大 于 10 并 且 人 口 小 于 2000 万 人 的 记录 筛选 出 来 。 

Where 语文 <60 Or 数学 <60 
只 要 有 一 科 不 及 格 的 就 列 出 来 。 

2. 使 用 Not 实现 条 件 的 否定 

SQL 语句 中 的 Not 关键 字 功 能 很 强大 ， 通 常 置 于 条 件 之 前 ， 起 到 和 否定 该 条 件 的 作用 。 

例如 : Where Not 人 口 <6000， 相 当 于 Where 人 口 >=6000。 

Where Not 简称 Is Null， 表 示 【 简称 】 字段 非 空 的 记录 。 

Not 不 仅 可 以 置 于 整个 条 件 之 前 ， 还 可 以 置 于 比较 关键 字 之 前 ， 例 如 : Where 简称 Is 
Not Null 等 价 于 Where Not 简称 Is Null。Where 区 域 Not In(' 东北 ',' 西北 ') 等 价 于 Where 
Not 区 域 In(' 东北 ',' 西北 ')。 Where 省 会 Not Like '% 州 "等 价 于 Where Not 省 会 Like '% 州 '。 


3. 使 用 Like 模糊 匹配 

与 VBA 中 的 Like 类 似 ，SQL 语句 中 的 Like 也 可 以 模糊 匹配 字段 中 的 内 容 。 
Like 语法 格式 如 下 。 

Where 字段 Like 含 通配符 的 表达 式 


可 以 使 用 的 通配符 有 如 下 几 种 情况 。 

口 %: 百 分 号 可 以 匹配 任意 多 个 任意 字符 。 

口 _: 一 个 下 画 线 可 以 匹配 一 个 任意 字符 。 

口 [ 你 我 他 ]: 可 以 匹配 你 、 我 、 他 三 个 字 中 的 任 一 个 。 

口 [A-G]: 可 以 匹配 A ~ G 之 内 的 任 一 个 。 

口 [IA-G]: 可 以 匹配 A ~ G 之 外 的 任 一 个 字符 ， 感 叹 号 表示 否定 。 
例如 : 

Select * From Detail Where 省 份 名 称 Like '$% 西 ' Rnd 区 域 Like ' 华 %' 


表示 匹配 以 “ 西 ”结尾 的 【 省 份 名 称 ]， 并 且 以 “ 华 ” 开 头 的 【 区域 ]， 结 果 如 图 8-28 所 示 。 


Select * From Detail Where 省 份 名 称 Like“% 西 ”And 区 域 Like“ 华 % 


[于 


半 二 二 二 面积 | 人口 [少数 民 请 
本 | 15.63 |3294 |0 
昌 便 东 |16.7 |4222 |o 
桂 | 南 于 ”| 华南 23.6 |4822 |! 


图 8-28 使 用 Like 和 通配符 进行 筛选 
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再 例如 : Where 省 份 名 称 Like '[! 山 陕 ] 西 '， 可 以 匹配 到 江西 、 广 西 ， 但 是 不 能 匹配 到 
陕西 、 山 西 。 


8.4.3 使 用 Order By 进行 排序 


Select 语句 中 可 以 包含 Order By 子 句 以 对 结果 记录 集 进 行 排序 。 具 体 语 法 格式 如 下 。 

Order BY 字段 或 表达 式 RSC 或 DESC 

其 中 ，ASC 是 升序 ，DESC 是 降序 。Order By 子 句 可 以 包含 一 个 以 上 的 排序 基准 ， 如 果 
第 1 个 基准 比较 不 出 大 小 ， 则 按 第 2 基准 ， 以 此 类 推 。 

针对 数据 记录 的 比较 ， 如 果 是 中 文 比较 ， 则 按照 拼音 顺序 ， 数 字 和 日 期 按照 大 小 ; 如 果 
记录 中 包含 空 值 (Null) 则 认为 是 最 小 。 

例如 : 


Select * From Detail Order By 区 域 ASC， 人 口 DESC 


表示 按照 区 域 升序 ， 当 区 域 相同 时 按照 人 口 降序 排列 ， 结 果 如 图 8-29 所 示 。 


elect * From Detail Order By 区 域 ASC, 人 DESC 
面积 


二 下 


En 区 


用 


二 是 


阿 
E 训 
和 
山东 
项 
浙江 
生计 | 
二 


上 aslslslslslslslslsl 


东 
西 
南 


| 十 南 耕 


| 涪 丙 个 恒 画 志 吉 潮 哈 阐 济 请 喇 同 0 


图 8-29 结果 记录 集 的 排序 


此 外 ， 排 序 的 关键 字 还 可 以 是 含 字段 名 称 的 表达 式 。 例 如 ， 按 各 省 份 人 口 密度 排序 ， 就 
需要 用 【 面积 】 除 以 【 人口 】 得 到 人 均 面 积 。 

下 面 的 SQL 语句 把 【面积 】/ 【人口 ] 的 结果 字段 重 命名 为 【 人 均 面积 ]， 然 后 按 人 均 
面积 降序 排列 。 


Select 省 份 名 称 ， 省 会 ， 面 积 ,人口 ， 面 积 / 人 口 Rs 人 均 面 积 From Detail Order By 面积 /人 
口 DESC 


可 以 看 到 西藏 和 青海 的 人 均 面 积 最 大 ， 地 广 人 稀 ， 结 果 如 图 8-30 所 示 。 


注意 ”如果 Select 子 句 中 同时 使 用 Where 和 Order By， 则 需要 把 Where 子 句 放 在 Order 
By 之 前 。 
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saL | [Select 省 份 名 称 , 省 会 加 可 人 口 ,面积 /人 口 As 人 均 面 积 From Detail 
brcer By 血 积 /人 口 ii 


.136540649067927 
1. 087033389296957 
4. 97257772390743E-02 
1. 58530304168836E-02 
1. 25936202400106E-02 
1. 19276159303006E-02 
1. 19171252627089E-02 
8. 34606550451297E-03 
5. 94331225310047E-03 
5. 6375101359864E-03 
5. 55055913635979E-03 
4. 89423483647236E-03 
a. 74439092727411E-03 
4. 58631696155062E-03 
4. 23412216110515E-03 
95547152130257E-03 


图 8-30 多 列 的 计算 结果 作为 排序 基准 


8.4.4 使 用 Group By 进行 分 类 汇总 


与 Excel 中 的 5 个 汇总 函数 类 似 ，SQL 中 也 允许 使 用 如 下 5 个 汇总 函数 对 记录 之 间 进 行 
汇总 。 

口 Min: 字段 的 最 小 值 。 

口 Max: 字段 的 最 大 值 。 

口 Sum: 字段 的 总 和 。 

口 Avg: 字段 的 平均 值 ，Null 值 不 统计 。 

口 Count: 非 空 记录 奇数 ，Null 值 不 统计 。 

例如 ， 下 面 的 SQL 语句 对 34 个 省 份 的 面积 进行 汇总 (数据 表 中 有 一 个 省 份 的 面积 为 
空 )。 


Select Sum( 面 积 ) As 总 面积 ,Avg( 面 积 ) As 平均 面积 ，Count( 面 积 ) As 计数 From 
Detail 


查询 结果 如 图 8-31 所 示 。 


加 Select Sum( 面 积 ) As 总 面积 , Avg( 面 积 As 平均 面积 ，Coun= (面积 ) As 计数 加 


[From Detail 


总 面积 | 平均 徊 各 | 
b [946. 9950|28. 69681|33 
* 


图 8-31 使 用 汇总 函数 
从 查询 结果 可 以 看 出 ，Sum 等 于 Avg * Count。 
以 上 实例 是 对 数据 表 的 总 体 汇 总 ， 但 很 多 情况 下 ， 需 要 按 某 字段 进行 分 类 汇总 ， 例 如 ， 
按照 【区 域 ] 类 别 各 自 汇 总 ， 统 计 一 下 华北 地 区 各 省 份 人 口 总 数 等 。 类 似 于 这 种 需求 ， 需 要 
使 用 Group By 子 句 对 字段 进行 分 组 ， 然 后 配合 汇总 函数 。 
下 面 的 SQL 语句 按 【 区域] 汇总 【人 口 ]。 
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Select 区 域 ,Sum( 人 口 ) Rs 区 域 人 口 From Detail Group By 区 域 


查询 结果 如 图 8-32 所 示 。 


加 | [Select 区 域 , Sum( 人 口 ) As 区 域 人 口 From Detail Group By 区 | 


区 域 “ 区 

» |1625 
10715 
14838 
|28798 
14441 
|22385 
|10422 
|20217 


到 一 以 梭 拘 搞 洲 
型 党 十 到 潭 洁 尖 


图 8-32 分 类 汇总 
如 果 对 汇总 的 组 进行 筛选 ， 此 时 不 使 用 Where 子 句 ， 而 是 使 用 Having 子 句 。 
例如 ， 只 汇总 区 域 人 口 大 于 20000 万 人 的 ， 那 需要 在 结尾 加 上 Having Sum( 人 口 )> 
20000。 


Select 区 域 ,Sum( 人 口 ) As 区 域 人 口 From Detail Group By 区 域 Having Sum( 人 口 )>20000 


查询 结果 如 图 8-33 所 示 。 


|Select 区 域 , Sum( 人 口 ) As 区 域 人 口 From Detail Group By 区 域 Having 。 
Sum( 人 口 )>20000 - 


| 


a 


东 28798 
素 中 |22385 
西南 “|20217 


图 8-33 汇总 结果 作为 筛选 条 件 


8.4.5 使 用 Select Into 语句 把 查询 结果 存 入 新 表 


前 面 已 经 讲 过 ， 使 用 Select 语句 一 般 会 返回 一 个 RecordSet 结果 记录 集 对 象 ， 如 果 想 
把 返回 的 查询 结果 直接 存 人 数据 库 ， 可 以 在 Select 子 句 的 From 子 句 之 前 加 入 Into 表 名 。 
下 面 的 代码 把 Select 语句 的 查询 结果 存 人 “人 口 分 类 汇总 ” 表 。 


Sub 查询 结果 存 表 () 
Set cnn = New ADODB.Connection 
With cnn 
.Connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinapProvince.accdb;Persist Security Info=False;" 
-Open 
IE -State = ADODB.ObjectStateEnum.adStateOpen Then 
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.Execute "Select 区 域 ,Sum [时 STE 
(人 口 ) Rs 区 域 人 口 Into 人 口 分 类 汇总 From Detail I ee oe sm sn oon sm 
Group By 区 域 " 
End If 
End With 
Set cnn = Nothing 
End Sub 


运行 上 述 过 程 ， 手工 打 开 Access 数据 
库 ， 可 以 看 到 多 了 一 个 “人 口 分 类 汇总 ”的 
表 ， 如 图 8-34 所 示 。 


图 8-34 使 用 SQL 语句 把 结果 记录 集 保存 为 新 表 


8.4.6 使 用 Insert Into 语句 增加 记录 
Insert Into 语句 可 以 向 表 中 添加 新 记录 。 
例如 ,在 VBA 中 ，Execute 如 下 SQL 代码 ， 可 以 向 Detail 表 中 增加 一 条 新 记录 。 


.Execute "Insert Into Detail Values(' 和 象牙 省 ',' 象 ',' 和 象牙 市 ',' 东 华 区 ',200,320, 
False)" 


重新 在 Access 中 打开 Detail 表 ， 可 以 看 到 最 下 面 多 了 一 行 记录 ， 如 图 8-35 所 示 。 


四 天 全 I 中 ”ChinaProvince ; 娄 报 库 - ENOWiceVBA 开 灿 经 次 \Ofice VBA 开 发 司 
| = ”zws ageTR Aeroboe 3 良 雪 

-BE 

所 有 Acces...@ «| 于 ocean = 

| | 而 称 省 会 区 声 面积 关口 “| 少数 民 浇 所 

二 < 国王 庆 庆 西南 8.23 1 加 

加 pe | 有 


J 回回 GG 本 加 


二 
o 
回 


图 8-35 增加 记录 


以 上 这 条 SQL 语句 执行 一 次 ， 增 加 一 条 ， 如 果 要 添加 大 量 新 记录 ， 需 要 把 上 述 语句 放 
入 循环 结构 中 。 
可 以 看 到 ，Insert Into.…Values 的 括号 中 是 新 记录 的 数据 ， 如 果 数 据 是 字符 串 ， 需 要 加 上 
单 引 号 ， 因 此 在 实际 编程 过 程 中 ,构造 这 条 语句 相当 麻烦 ， 一 般 使 用 RecordSet.AddNew 方 
法 增加 新 记录 。 
与 Insert Into 相 比 ，RecordSet 的 AddNew 方法 不 需要 构造 复杂 的 SQL 语句 ， 只 需要 规 
定 各 个 字段 的 具体 取 值 即 可 。 下 面 的 过 程 向 Detail 表 增 加 两 条 新 记录 。 
Sub 增加 新 记录 () 
Set cnn = New ADODB.Connection 
With cnn 
-ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\ChinaProvince.accdb;Persist Security Info=False;" 


.Open 
End With 
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Set rst = New ADODB.Recordset 
With rst 
-CursorLocation = adUseClient 
.Open Source:="Detail", ActiveConnection:=cnn, CursorType:=ADODB .Cursor 
TypeEnum.adOpenKeyset, LockType:=ADODB .LockTypeEnum.adLockOptimistic 
-RddNew 
.Fields (" 省 份 名 称 ") .Value = " 新 省 份 1" 
.Fields ("简称 ") .Value = "新 " 
.Fields (" 省 会 ") .Value = "新 省 会 1" 
.Fields(" 区 域 ") .Value = "新 区 域 1" 
-Fields(" 人口 ") .Value = 230 
-Fields (" 少数 民族 自治 区 ") .Value = False 
.Update 
-RddNew 
.Eields(" 省 份 名 称 ") .Value = "新 省 份 2" 
.Fields(" 简称 ") .Value = "新 " 


.FEields(" 省 会 ") .Value = "新 省 会 2" 
.Fields (" 区域") .Value = "新 区 域 2" 
.Fields(" 人口 ") .Value = 270 


.Fields (" 少数 民族 自治 区 ") .Value = True 
.Update 
.Close 

End With 

cnn.Close ' 关闭 cnn 

Set rst = Nothing 

Set cnn = Nothing 

End Sub 


代码 分 析 : 规定 完 各 个 字段 的 取 值 后 ， 要 用 RecordSet 的 Update 方法 才能 把 数据 存 人 
数据 库 中 。 运 行 上 述 代码 ， 可 以 看 到 Detail 表 下 面 多 了 两 行 ， 如 图 8-36 所 示 。 


国 Detail\、 

省 份 名 称 -| 而 称 -| 省 会 -| 区 域 -| 面积 -| 人 人 口 | 少数 民族 E- 

| 重庆 渝 重庆 西南 8.23 3107 

西藏 藏 本 萨 西南 122.8 267 回 

,新 疆 新 乌鲁木齐 ”西北 166 1906 回 

| 甘肃 甘 、 陇 兰 ， 西北 45. 44 3813 四 

青海 青 yn 西北 72.23 529 

陕西 陕 、 秦 西北 20. 56 3647 

:: 二 银 儿 西 6.64 527 贺 

新 

回 

0 0 


图 8-36 添加 多 条 记录 


8.4.7 ”使 用 Delete 语句 删除 记录 


Delete 语句 用 于 从 数据 表 中 删除 记录 ， 一 般 和 Where 子 句 配合 使 用 ， 可 以 选择 性 地 
删除 。 
例如 ， 下 面 的 SQL 语句 可 以 删除 原 数据 表 中 所 有 【 区 域 ] 为 西南 的 记录 。 


Delete From Detail Where 区 域 =' 西南 " 


如 果 后 面 不 带 Where 子 句 ， 则 会 清空 数据 表 的 所 有 记录 。 
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8.4.8 使 用 Update 语句 修改 记录 


Update 语句 用 来 修改 更 新 原 数据 表 中 的 特定 记录 数据 。 语 法 格式 如 下 。 

Update 表 名 Set 字段 名 1= 值 1, 字段 名 2= 值 2 Where 子 名 

下 面 的 SQL 语句 把 【 区域 ] 为 西北 的 各 省 份 的 省 会 追加 一 个 “市 ” 字 ， 然 后 把 面积 都 
设置 为 100。 

Update Detail Set 省 会 = 省 会 +' 市 ', 面积 =100 Where 区 域 =' 西北 ' 

执行 上 述 SQL 语句 后 ， 在 Access 中 可 以 看 到 Detail 表 中 有 5 行 记录 被 修改 ， 如 图 8-37 
所 示 。 


习 Detail 

省 份 名 称 -| 而 称 -| 省 会 -| 区 域 -| 面积 -| 人 人口 | 少数 民族 和 - 

江苏 苏 南京 华东 10.26 7381 

安徽 皖 合 | 华东 13. 97 

_| 上 海 上 海 .63 1625 

浙江 浙 杭州 华东 10.2 4647 

江西 蓝 华东 16.7 4222 

福建 图 福州 华东 12.13 3466 

_ 河南 了 更 华中 16.7 9768 

湖北 邯 武汉 华中 18.59 5988 

湖南 湘 华中 21.18 6629 

广东 粤 广州 华南 18 7859 

广西 桂 南宁 华南 23.6 4822 回 

海南 省 琼 海口 华南 3.4 803 

_ 香港 港 华南 11 686 

澳门 澳 澳门 华南 025 44 

台湾 华南 3.6 227 

新 可 

甘 、 西 4 

青 

陕西 陕 、 

5 回 

象牙 省 象 象牙 市 东 华 区 200 320 

六 0 0 

图 8-37 修改 记录 


8.4.9 处 理 SQL 语句 中 的 单 引号 


如 果 数 据 表 的 记录 中 本 身 包含 单 引号 ， 在 书写 SQL 语句 时 ， 要 把 一 个 单 引号 替换 为 连 
续 的 两 个 单 引号 。 

在 SQL 语句 中 ， 由 于 整个 语句 外 侧 是 两 个 双 引号 ， 因 此 语句 内 部 一 律 使 用 单 引 号 。 两 
个 单 引号 包 起 来 的 内 容 表示 常量 字符 串 ， 如 果 字 符 串 本 身 有 单 引 号 ， 则 每 个 单 引号 需要 写成 
两 个 单 引号 才 行 。 

在 数据 表 中 ， 把 区 域 是 华北 ， 并 且 外 侧 有 单 引 号 的 记录 ， 相 应 的 省 会 也 加 上 单 引 号 。 也 
就 是 说 ， 把 石家庄 改 成 ' 石家庄 '， 如 图 8-38 所 示 。 

根据 上 述 需求 ， 或 许 会 写 出 如 下 的 SQL 语句 : 


cnn .Execute“Update Detail Set 省 会 ='''+ 省 会 +'"''， 面积 =100 Where 区 域 =' 华北 ''" 
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蛋 Detail 


省 份 名 标 “| 再 称 “| 省 会 “| 区 二 
| | 黑龙。 黑 哈尔滨 “东北 
国 井 时 长 春 “东北 
国 辽 宁 这 沈阳 东北 
[ 护 京 北京 。 华北 
[pF 蓝 
站 wu 示 和 鲁 济南 。 。” 华 东 
加 mr 苏 苏 南京 ”华东 


| 面积 -| 和信 口 | 少数 民族 和- 
45. 48 3813 
18.74 2699 
15.59 4203 
1.68 1423 


118.3 2379 
15.38 9082 
10.26 7381 


图 8-38 区域 字段 包含 单 引号 的 记录 


但 是 执行 程序 时 ， 会 出 现 “操作 符 丢 失 ” 的 
运行 时 错误 提示 ， 如 图 8-39 所 示 。 

以 上 语句 有 两 处 错误 ， 第 一 处 是 省 会 左右 两 
侧 各 需要 4 个 单 引号 才 行 ， 因 为 “省 会 ”本 身 是 
字段 名 称 ， 这 里 要 与 左右 两 侧 部 分 进行 连接 运算 ， 
因此 4 个 单 引号 才能 表示 一 个 真正 的 单 引号 。 

另 一 处 错误 是 Where 子 句 中 ， 华 北 左右 两 侧 


Microsoft Visual Basic 


运行 时 错误 “-2147217900 (60040e14) ; 
语法 错误 (操作 符 去 失 ) 在 查询 素 达 式 “ 区 域 = “西北 …“ 中。 


关口 | 结束 四 | [国语 


帮助 00 


图 8-39 单 引号 造成 的 错误 


各 需要 3 个 单 引号 。 这 是 因为 华北 本 身 是 常量 字符 串 ， 包 含 于 单 引 号 之 中 。 


修改 为 如 下 形式 。 


cnn.Execute “Update Detail Set 省 会 ="" 


& 省 会 & ""， 面积 =100 Where 区 域 ="' 华北 '"" 


再 次 执行 ， 可 以 看 到 省 会 的 两 侧 加 上 了 单 引 号 ， 如 图 8-40 所 示 。 


习 Detail 
省 份 名 称 -| 简称 | 面积 -| 人 口 | 少数 民族 E- 
黑 45. 48 3813 品 
_ 吉林 吉 18.74 2699 
| 辽宁 辽 15.59 4203 
J 北京 京 1.68 1423 
| 天 津 津 1.13 1007 
河北 蓝 100 6735 
| 山西 晋 100 3294 
_| 内 蒙古 蒙 118.3 2379 回 
国 山东 鲁 15.38 9082 


图 8-40 ”正确 处 理 单 引号 


在 编程 开发 过 程 中 ， 经 常 要 把 带 有 单 引 号 的 内 容 作 为 查询 条 件 ， 或 者 把 带 有 单元 格 的 内 
容 存 人 数据 库 。 可 以 利用 VBA 中 的 Replace 函数 把 单 引 号 替换 后 再 执行 ， 这 是 一 个 稳妥 的 


做 法 。 


以 上 内 容 的 源 代码 文件 为 “实例 文档 46.xlsm”。 


8.5 修改 数据 库 结构 


SQL 语句 除了 可 以 操作 现 有 表 的 记录 外 ， 还 可 以 进行 创建 数据 库 ， 创 建 和 修改 数据 表 ， 


创建 和 修改 字段 等 操作 。 
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8.5.1 自动 创建 新 数据 库 
若 要 自动 创建 数据 库 ， 需 要 向 VBA 工程 添加 外 部 引用 “Microsoft ADO Ext 2.8 forDDL 
and Security”， 如 图 8-41 所 示 。 


引用 - VBAProject 


可 使 用 的 引用 A): 
Y 取消 


Visual Basic For Applications 
Microsoft Excel 15.0 Object Library 
MMOLE Autonation 得 - 
四 上 ereseft Office 15.0 Object Libra 浏览 四)... 
Microsoft ActiveX Data Objects 2.8 
[li crosoft AD0 Ext. 2 8 for ITL and 全 
DMierosoft Forms 2.0 Object Library 


DVBAProject lt 
DvBaprejset be 才 助 00 
CANIMCPl1 ayEneine + 


DAccessibilityCplAdnin 1.0 Type Liby 
DAccountProtect 1.0 Type Library 
口 Aerobat 


站 ae=ahat hnors 3_n Tome Tihrarw 
1 


-Microsoft AD0 Ext. 2.8 for DDL and Security 一 一 一 一 一 
定位 : C:\Program Files\Common Files\System\ado\msadox26. 
语言 标准 


图 8-41 添加 外 部 引用 


添加 该 引用 后 ， 运 行 如 下 VBA 过 程 ， 即 可 在 工作 簿 所 在 路 径 下 自动 产生 一 个 Student. 
accdb 的 新 数据 库 文件 。 


Sub 创建 Access 数据 库 () 
Dim cat As ADOX.Catalog 
Set cat = New ADOX.Catalog 
cat.Create "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook. 
Path & "\Student.accdb;" 
End Sub 


但 是 ,创建 的 数据 库 里 面 没有 任何 数据 表 ， 是 一 个 空白 数据 库 。 


8.5.2 ”自动 创建 新 表 


SQL 语句 中 的 Create Table 语句 用 来 向 数据 库 中 添加 新 表 。 
下 面 的 VBA 过 程 向 已 有 的 Student 数据 库 中 创建 一 个 “基本 信息 ” 表 ， 并 且 自 动 添加 
一 条 数据 记录 。 


Sub 创建 数据 表 () 
Dim cnn As ADODB.Connection 
Set cnn = New ADODB.Connection 
With cnn 
-ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\Student.accdb;Persist Security Info=False;" 
.Open 
.Execute CommandText:="Create Table 基本 信息 ( 姓名 char(4)，, 性 别 char (1)， 
出 生日 期 Date, 年 龄 int)" 
.Execute CommandText:="Insert Into 基本 信息 Values(' 刘 永 富 ',' 男 ','1981- 
T1532” 
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End With 
Set cnn = Nothing 
End Sub 


代码 分 析 :“Create Table 基本 信息 (姓名 char(4), 性 别 char(1), 出 生日 期 Date, 年 龄 int)” 
这 一 句 是 关键 代码 ， 意 思 是 创建 一 个 名 称 为 “基本 信息 ”的 表 ， 包 含 姓名 、 性 别 、 出 生日 期 、 
年 龄 四 个 字段 ， 并 且 规 定 了 每 个 字段 的 类 型 和 字符 长 度 。 

运行 上 述 过 程 ， 从 Access 中 可 以 看 到 刚 创建 的 表 ， 如 图 8-42 所 示 。 


四 基本 信息 - Access Es 了 

| = ypees 。 %EFTR Acobal 。 训 计 a 了 站 -sx 
村 
所 有 Acces..B“ 
关 - 


雪 
加 人 


子 自居 信 


字 了 人 称 最 长 可 到 64 个 字符 折 拉 8), 按 
一 FL 名 中 盏 看 有 天 字 友 名 榨 的 入 


加 
EEIEIE] 


人 
到 


图 8-42 ”自动 创建 新 表 
并 且 可 以 看 到 该 表 中 已 经 有 一 条 数据 记录 。 


8.5.3 ”字段 的 增加 删除 和 修改 


SQL 语句 中 的 Alert Table 子 句 可 以 对 现 有 数据 表 的 结构 进行 修改 。 修 改 字段 的 语法 
如 下 。 

口 Add Column 新 字段 名 类 型 (长 度 ): 增加 新 字段 。 

口 Drop Column 字段 名 : 删除 字段 。 

口 Alter Column 字段 名 字段 类 型 (长 度 ): 修改 现 有 字段 的 类 型 。 

下 面 的 过 程 向 基本 信息 表 增 加 【 住址】 和 [身份 证 号 码 】 两 个 字段 ， 并 且 删 除 [ 出 生日 
期 ] 字段 ， 把 【性 别 ] 字段 的 类 型 从 char 修改 为 memo (备注 型 )。 


Sub 修改 字段 () 
Dim cnn As ADODB.Connection 
Set cnn = New ADODB.Connection 
With cnn 


.Connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & "\Student.accdb;Persist Security Info=False;" 
-Open 
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.Execute CommandText:="Alter Table 基本 信息 Rdd Column 住址 char (10)， 身 份 
证 号 码 char (18) " 
.Execute CommandText:="Alter Table 基本 信息 Drop Column 出 生日 期 " 
.Execute CommandText:="Alter Table 基本 信息 Alter Column 性 别 memo" 
End With 
Set cnn = Nothing 
End Sub 


运行 上 述 过 程 ， 从 Access 中 以 设计 视图 打开 “基本 信息 ” 表 ， 可 以 看 到 各 个 字段 的 变 
化 ， 如 图 8-43 所 示 。 


四 去 民工 中 
| = yesms wesTR Acobet ii 
日 5- ee 
所 有 Acces.…@ “ = 
2 < 广 
表 和 数 
半天 本 信息 短文 本 


住址 
身份 证 号 码 短文 本 


图 8-43 ”删除 和 修改 字段 


8.5.4 ”自动 删除 数据 表 

删除 表 的 SQL 语句 很 好 写 ，Drop Table 基本 信息 ， 就 可 以 把 名 为 “基本 信息 ”的 表 从 
数据 库 中 删除 。 

以 上 内 容 的 源 代码 文件 为 “实例 文档 47.xlsm” 
8.6 访问 其 他 类 型 的 数据 库 


在 编程 过 程 中 ， 要 处 理 的 数据 未 必 都 存放 在 Access 数据 库 中 ,很 多 情况 下 还 存储 
Excel 文件 、 文 本 文件 中 ，ADO+SQL 技术 ， 同 样 适用 于 数据 比较 规范 的 其 他 数据 库 。 


8.6.1 连接 字符 串 的 构造 


使 用 ADO 能 否 正 常 操作 和 访问 一 个 数据 库 ， 关 键 在 于 连接 字符 串 是 否 正确 。 各 种 类 型 
数据 库 的 连接 字符 串 如 表 8-1 所 示 。 


nl 


表 8-1 常见 数据 库 的 连接 字符 串 


数据 库 类 型 
Access 2003 数据 库 
Access 2007 以 上 数据 库 


连接 字符 串 


Provider=MicrosoftACE.OLEDB.12.0:Data Source=DBName:Persist 
Security Info=False: 


Provider=Microsoft.ACE.OLEDB.12.0;Data Source=DBName:Jet 
OLEDB:Database Password=MyDbPassword: 


Access 数据 库 (有 密码 ) 


Provider=Microsoff.ACE.OLEDB.12.0:Data Source=DBName:Extended 


Excel 97-2003 文件 
Properties="Excel 8.0:HDR=YES":; 


2 动 ”office VBA 开发 经 典 一 中 级 进 阶 卷 


续 表 


数据 库 类 型 连接 字符 串 
Provider=Microsoft.ACE.OLEDB.12.0:Data Source=DBName:Extended 
Properties="Excel 12.0 Xml:HDR=YES:IMEX=1"; 

Provider=Microsoft. ACE.OLEDB.12.0:Data Source=DBName:Extended 
Properties="Excel 12.0 Macro:HDR=YES": 


en Provider=Microsoft.Jet.OLEDB.4.0:Data Source=DBName\:Extended Prope 
文本 文件 -txt 或 csv | is 
Tties="text:HDR=Yes:FMT=Delimited"; 


Excel 2007 以 上 工作 和 


启用 宏 的 工作 簿 


表 中 提 到 的 DBName 就 是 数据 库 的 路 径 。 
针对 各 种 类 型 数据 库 的 连接 方式 ， 可 以 访问 : https://www.connectionstrings.com/excel/ 、 


https://www.connectionstrings.com/access/。 


8.6.2 ”查询 Excel 工作 表 数 据 


如 果 一 个 Excel 工作 短文 件 中 含有 格式 规范 的 数据 ， 也 可 以 在 VBA 中 通过 ADO 技术 
把 Excel 文件 当 作 数 据 库 进 行 查询 。 

现在 假定 磁盘 下 有 一 个 名 为 “学 生成 绩 表 .xlsm” 的 Excel 文件 ， 这 个 工作 夭 包 含 一 个 
名 为 “第 二 学 期 ”的 工作 表 ， 表 中 有 4 个 班级 的 学 生成 绩 ， 如 图 8-44 所 示 。 


[ 丰 = 攻 2 学 生成 绩 表 xlsm - Excel 
| = rm 全 SB 讽 让 ITR BE 
Al ~ wv 天 | 学 号 
B D E F G H I K 
国字 号。 ,姓名 性 别 班级 数学 语文 物理 化 学 英语 体育 总 分 
2 |cY018 金龙 主 男 初 一 1 班 81 58 84 50 70 55 398 
3_|cY001 。 姚 晨 梦 。 女 初 一 1 班 99 96 90 90 75 88 514 
生 |CY002 。 吴 果 羽 ” 女 初 一 1 班 88 94 51 57 70 62 422 
5 |cY003 尤 福 根 男 初 一 1 班 65 96 53 71 69 80 434 
6 ICY004 ” 王 秋月 男 初 一 1 班 81 82 94 66 87 65 475 
7 IcY005 。 赵 梦 琦 ” 女 初 一 1 班 92 82 97 55 51 63 440 
8 ICY006 卢 佳 建 ” 男 初 一 1 班 72 65 64 98 50 81 430 
9 ICY007 ” 陈 梦 迪 男 初 一 1 班 98 61 58 85 66 80 448 
10 ICY008  。 杨 鸿 翔 。 男 初 一 1 班 62 58 82 56 58 96 412 
11 ICY009 卢 雨 晴 女 初 一 1 班 83 71 70 77 86 100 487 
12 ICY010 金融 男 初 一 1 班 74 98 95 89 85 56 497 
13 |cYoll 周 俊杰 男 初 一 1 班 98 74 97 50 62 61 442 
14 ICY012 吴越 男 初 一 1 班 80 60 62 63 65 82 412 
15 ICY013 徐 思 雨 女 初 一 1 班 91 63 88 70 53 90 455 
16 |CY014 沈 玉 洁 女 初 一 1 班 54 59 79 ?1 65 65 393 
17 |cYol5 。 郭 教 燕 。 女 初 一 1 班 62 90 53 53 66 ?1 395 
18 |cYol6 杨 何 波 男 初 一 1 班 80 79 78 80 92 63 472 
19 |cYol7 。 吴 哟 飞 “ 男 初 一 1 班 93 86 54 81 93 60 467 
20 ICY019 。 杨 晓 奇 “ 男 初 一 1 班 100 97 到 92 83 98 547 
21 |cY020 请 曲 男 初 一 1 班 51 78 83 69 94 52 427 
22 ICY021 ” 蒙 伟 间 男 初 一 1 班 84 97 52 79 98 69 479 
23 |CY022 。 罗 黄 黄 。 女 初 一 1 班 88 ?71 96 53 61 59 428 
24 ICY023 。 吴 一 帆 男 初 一 1 班 54 ?1 51 ?7 62 81 396 
25 ICY024 沈 现 琦 ” 男 初 一 1 班 90 73 85 52 53 73 426 
26 |cY025 。 沈 闻 婷 女 初 一 2 班 80 95 99 62 73 85 494 
27 ICY026  _ 杨 字 男 初 一 2 班 97 B84 51 77 85 70 464 
28 ICY027 金 彤 听 男 初 一 2 班 56 62 71 92 8d4 87 452 
29 |cY028 。 卢 晓 雨 男 初 一 2 班 97 90 52 87 91 66 483 
30 |cY029 叶 晴 晴 女 初 一 2 班 92 52 73 74 66 9¢ 451 
31 ICY030 徐 世 莲 女 初 一 2 班 60 91 64 74 59 B64 412 
4 第 二 学 期 由 


图 8-44 ”Excel 示例 数据 表 
在 其 他 工作 短 中 创建 如 下 VBA 过 程 ， 用 来 查询 学 生成 绩 表 中 【 班级 】 为 初 一 1 班 ， 并 
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且 按 【数学 】 降 序 排列 。 


Public cnn As ADODB.Connection, rst As ADODB.Recordset 
Sub QueryExcel () 
Set cnn = New ADODB.Connection 


With cnn 
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & 
ThisWorkbook.Path & "\ 学 生成 绩 表 .xlsm;Extended Properties='Excel 12.0 Macro;HDR=YES'" 
.Open 


If .State = ADODB.ObjectStateEnum.adStateOpen Then 
Set rst = New RDODB.Recordset 
rst.CursorLocation = adUseClient 
rst.Open Source:="Select * From [第 二 学 期 $] Where 班级 =' 初 一 1 班 ' Order 
By 数学 DESC"，ActiveConnection:=cnn, CursorType:=ADODB.CursorTypeEnum.adOpenKeyset, 
LockType:=ADODB.LockTypeEnum.adLockOptimistic 
If rst.State = ADODB.ObjectStateEnum.adStateOpen Then 
Debug.Print "结果 记录 集 的 记录 总 数 : "，rst.RecordCount 
Debug.Print "结果 记录 集 的 字段 总 数 : "，rst.Fields.Count 
For Each fld In rst.Fields 
Debug.Print fld.Name, fld.Type, fld.Value 
Next fld 
ActiveSheet .Range ("A2") .CopyFromRecordset rst 
Dim i As Integer 
For i = 0 To rst.Fields.Count - 1 
ActiveSheet.Cells(l1, i + 1) .Value = rst.Fields(i) .Name 


Next i 
rst.Close ' 关 闭 rst 
End If 
.Close ' 关 闭 cnn 
Else 
MsgBox "失败 ! "，vbExclamation 
End If 
End With 
Set rst = Nothing 
Set cnn = Nothing 
End Sub 


代码 分 析 : 与 查询 Access 数据 库 有 以 下 两 点 不 同 。 

口 连接 字符 串 有 所 不 同 ， 由 于 数据 源 是 启用 宏 的 工作 簿 ， 因 此 连接 字符 串 后 面 带 有 
Extended Properties='Excel 12.0 Macro:HDR=YES'。 

口 表 名 的 写法 不 一 样 ，Access 中 的 表 名 直接 书写 即 可 ，Excel 文件 的 某 个 工作 表 作为 数 
据 源 ， 则 和 需要 写作 : [第 二 学 期 $]， 如 果 要 把 指定 的 一 个 区 域 作为 查询 的 数据 源 ， 在 
$ 后 面 加 上 单元 格 地 址 即 可 ,例如 : [第 二 学 期 SA1:D10]。 

运行 上 述 过 程 ， 结 果 记 录 集 打印 到 活动 工作 表 中 ， 如 图 8-45 所 示 。 

可 以 看 到 ， 查询 出 的 记录 只 有 初 一 1 班 的 ， 而 且 按 数学 成 绩 降序 排列 。 

需要 注意 的 是 ， 查 询 过 程 中 被 查询 的 工作 短 不 需要 在 Excel 中 打开 ,也 就 是 说 ADO 可 

以 访问 处 于 关闭 状态 的 Excel 文件 。 

另外 ,使 用 ADO+SQL 操作 Excel 文件 时 ， 支 持 Select 语句 、Insert Into 语句 和 Update 

语句 ,但 是 不 支持 Delete 语句 ， 也 就 是 不 能 用 Delete 语句 删除 工作 短 中 的 数据 记录 。 
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L 实 强 文 芒 48xtsm - Excel 
| = 加 
> Xx v 天 | 学 号 
c 也 E Ek E 

性 别 班 洱 到 了 王 文 英语 笨 育 号 分 

村 初 一 1 班 Ia 多 强 到 她 SU7 
女 初 二 1 班 9 86 30 了 5 8 sl 
男 初 一 1 班 98| 4 50 62| 61 442 
男 初 一 1 班 98| 61 85 E6 80 448 
田 初 一 1 班 99| 86 En 93| 60 7 
妇 初 一 1 班 92| 82 55 5 63 440 
E3 初 一 1 班 | 63 70 53| 30 455 
男 初 一 1 班 90| 73| 52 5 T3 #26 
女 初 -1 班 838| 1 53 a 59 #28 
Es 初 一 1 班 838| 94 57 70 62 422 
男 初 一 1 班 34| 37 19 58 69 479 
女 初 一 ! 班 83| 11 T7 56 100 487 
更 初 一 1 班 al 82| 655 57 55 #75, 
于 初 一 1 班 al 58| 50 TD 55 398 
男 初 一 1 班 Ey 60 63 65 82 412 
于 初 一 1 班 20| 79 80 82 63 #72 
于 初 一 1 班 74| 98 89 55 56 497 
黑 初 一 1 班 72| 65 98, 50 81 430 
田 初 二 天 | gE 7 9 80 434 
男 初 一 1 班 62| 58， 56 58 86 #12 
女 初 一 1 班 62| 90 53 E6 到 395 
去 初 一 1 班 54| 59 71 65 65 393 
男 初 一 1 班 Es 11 77 62 81 396 
男 初 -] 班 EY ?6 69 EE 52 42? 


图 8-45 ”以 Excel 文件 为 数据 源 的 查询 结果 


8.6.3 查询 CSV、TXT 文件 


使 用 逗号 分 隔 值 ( Comma-Separated Values，CSV， 有 时 也 称 为 字符 分 隔 值 ， 因 为 分 隔 字 
符 也 可 以 不 是 逗号 ) 的 文件 以 纯 文 本 形式 存储 表格 数据 (数字 和 文本 )。CSV 文件 由 任意 数目 
的 记录 组 成 ， 记 录 间 以 某 种 换行 符 分 隔 。 每 条 记录 由 字段 组 成 ， 字 段 间 的 分 隔 符 是 逗号 或 制 


表 符 。 


Excel 工作 表 可 以 另存 为 CSV 文件 ， 使 用 记事 本 程序 也 可 以 编辑 数据 并 另存 为 CSV 文 
件 。 对 于 已 存在 的 CSV 文件 ， 使 用 Excel 或 记事 本 程序 可 以 对 其 进行 编辑 和 修改 。 
如 图 8-46 所 示 ， 记 录 学 生成 绩 的 一 个 CSV 文件 ， 可 以 看 到 该 文件 包含 $ 列 (5 个 字 


段 )， 列 之 间 使 用 逗号 作为 分 隔 符 。 


[ss -ia 看 本 


ES 二 | 


pr 


数学 , 英 
相思 二 和 人 ,90, 78, 本 
HG201802, ， 92， 82, 对 


HG201803, ,3 3 53 
HG201804, % 6, 58 
HG201805, ' J 76 
lH6201806, 软 书 松 ; 71 85, 93 


中 ae201807, 起 于 , 83, 95, 95 
上 HG6201808, 清理 , 84, 57, 86 


HG201809, 杨 关 中 ,30, 54, 93 
NHG201810, ,55, 71, 68 
MHG201811, ,96, 74, 93 


IHG201812, 人 5 74, 59 
HG201813; 韦 ,90, 86, 94 
IHG201814, 54, 61, 74 


IHG201815, 三 , 94, 80, 65 
NHG201816, 74, 66, 54 
上 HG6201817, 邓 阳 , 83, 61, 96 
中 BE201818, 将 伊美 , 60, 91, 73 
中 86201819, 十 坞 , 66, 90, 92 


HG201821, ;人生 69, 51, 62 
HG6201822, 陶 银 : 


HG201823; 时 三 各 2 85, 85 
HG201824, 83, 58, 97 
HG201825, ,75, 51, 98 


图 8-46 典型 的 CSV 文 件 
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下 面 讲 述 如 何 使 用 ADO+SQL 技术 查询 来 自 CSV 文件 的 数据 。 
CSV 文件 、TXT 文件 都 属于 文本 文件 ， 查 询 文本 文件 的 连接 字符 串 语法 格式 如 下 。 


Provider=Microsoft.Jet.OLEDB.4.0; 
Data Source=FolderName\; 
Extended Properties='text;HDR=Yes;FMT=Delimited'; 


其 中 ，Data Source 指明 了 文本 文件 的 所 在 位 置 。Extended Properties 是 扩展 属性 ， 其 中 
的 text 表示 文本 文件 ，HDR=Yes 时 ， 文 本 文件 的 首 行 被 当 作 字段 行 ， HDR=No 时 ， 认 为 文 
本 文件 没有 字段 行 ， 所 有 内 容 都 是 记录 。 

FMT 参数 用 来 规定 列 与 列 之 间 的 分 隔 符 。 如 果 是 以 逗号 分 隔 的 CSV 文件 ，FMT 设置 为 
Delimited ;如 果 是 以 制 表 位 分 隔 的 文本 文件 ， 设 置 为 TabDelimited ;如 果 是 以 字母 x 分 隔 的 
文件 ，FMT 设置 为 Delimited(x)。 

需要 注意 的 是 ， 查 询 文 本 文件 时 ，SQL 语句 中 的 From 后 面 要 加 上 文本 文件 的 名 称 ， 例 
如 Select * From 成 绩 总 表 .csv， 如 果 文 本 文件 的 名 称 本 身 包含 空格 ， 还 需要 把 整个 文件 名 用 
方 括号 括 起 来 ， 例 如 : 


Select * From [成 绩 总 表 .csv] 


如 果 不 加 方 括号 ,会 引起 “From 子 句 错误 ”。 
以 下 程序 从 “成 绩 总 表 .csv” 中 查询 数学 成 绩 高 于 90 分 的 记录 ， 查 询 结果 发 送 至 工作 
表 中 。 


Sub QueryCsV() 
Set cnn = New ADODB.Connection 
With cnn 
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 
ThisWorkbook.Path & ";Extended Properties="'text;HDR=YES;FMT=Delimited'™" 
.Open 
Set rst = New ADODB.Recordset 
rst.CursorLocation = adUseClient 
rst.Open Source:="Select * From 成 绩 总 表 .csv Where 数学 >=90"，ActiveConnection:= 
cnn, CursorType:=ADODB.CursorTypeEnum.adOpenKeyset, LockType:=ADODB .LockTypeEnum. 
adLockOptimistic 
ActiveSheet .Range ("A2") .CopyFromRecordset rst 
Dim i As Integer 
For i = 0 To rst.Fields.Count - 1 
ActiveSheet.Cells(1, i + 1) .Value = rst.Fields (1I) .Name 
Next i 
rst.Close ' 关 闭 rst 
-Close ' 关闭 cnn 
End With 
Set rst = Nothing 
Set cnn = Nothing 
End Sub 


上 述 程序 与 一 般 的 ADO+SQL 写法 没什么 不 同 ， 主 要 关注 ConnectionString 那 句 代码 ， 
还 有 执行 SQL 查询 的 那 名 代码 即 可 。 
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如 果 文 件 夹 中 存在 多 种 分 隔 符 的 文本 文件 ， 可 以 用 记事 本 程序 编写 一 个 schema.ini 文件 
来 表明 每 个 文本 文件 的 分 隔 符 类 型 、 字 段 名 称 和 数据 类 型 、 是 否 有 标题 行 等 属性 。 

假设 文件 夹 下 有 一 个 “Tab 分 隔 表 txt” 和 一 个 “符号 分 隔 表 -kt"， 其 中 的 内 容 如 图 
8-47 所 示 。 


轩 Tab 分 而 表 bd -记事 本 ola] | as et 
EECOETEECOE RDO 

学 号 ”姓名 语 数学 ”英语 < 这 于 = 
Ho201801 遇 民 90 78 81 四 +31 
HG201802 有 92 822 91 Ee 
HG201803 钟 88 96 53 

HG201804 渐 88 76 58 

HG201805 兰 遇 57 76 76 
MHG201806 松 71 85 93 
MHG201807 武平 83 95 95 

HG201808 84 57 86 
MHG201809 忠 90 54 93 

HG201810 55 71 68 
MHG201811 其 96 74 93 

HG201812 75 74 59 

HG201813 韦 维 风 90 86 94 

HG201814 由 ~ 54 61 4 

HG201815 兰 94 80 65 

HG201816 74 66 54 

HG201817 83 6 6 

HG201818 美 60 91 3 

HG201819 66 90 92 

201820 则 岩 。 63 75 31 

HG201821 外 年 69 51 62 

HG201822 84 1 8 

HG201823 田 52 85 85 

HG201824 前 83 58 97 

HG201825 陈 泌 ” 75 51 8 


图 8-47 不 同 分 隔 符 的 CSV 文件 
然后 创建 一 个 记事 本 文件 ， 书 写 如 下 内 容 ， 并 另存 为 schema.ini， 如 图 8-48 所 示 。 


schemaini -记事 本 下 
| 文件 (R。” 蝙 蚀 (E) 格式 (O) 查看 (V) 帮助 (H) 
[Tab 分 隔 表 . txt] 


Format=TabDelimited 


[符号 分 隔 表 . txt] 


Format=Delimited(*) 
ColNameHeader = False 


图 8-48 ”schema.ini 文件 的 内 容 


文件 内 容 的 含义 是 ,“ Tab 分 隔 表 .txt” 这 个 文件 的 分 隔 符 是 Tab 制 表 位 ,“ 符 号 分 隔 
表 .txt” 这 个 文件 的 分 隔 符 是 *， ae 
即使 程序 代码 中 仍然 使 用 前 面 讲 过 的 连接 字符 串 : 


Connectionstring = "Provider=Microsoftt.RACE.OLEDB.12.07Data Source=" & 
ThisWorkbook.Path & ";Extended Properties="'text;HDR=YES;FMT=Delimited'™" 


由 于 文本 文件 路 径 下 存在 这 个 schema.ini 文件 ， 因 此 以 这 个 文件 中 的 设 定 为 准 。 

其 中 ,根据 “符号 分 隔 表 .txt” 这 个 文件 查询 的 结果 ， 如 图 8-49 所 示 。 

由 于 该 文件 没有 标题 行 ， 所 以 返回 的 结果 记录 集 的 字段 名 称 使 用 默认 的 F1、F2 

如 果 文 件 夹 下 没有 schema.ini 文件 ， 运 行 同样 的 程序 不 能 得 到 期 望 的 效果 ， 往 往 不 能 正 
常 分 列 ， 如 图 8-50 所 示 。 
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a B EC D 
1 FL F2 F3 i Fd 1 A B 
双全 一 人 一 和 | 
| 2 | 李 四 #31# 女 站 | 程 ， 
和 了 和 6 一 一 去 一 独 浅 理 3 | 王 五 *26+ 女 * 部 门 经 理 
5 
图 8-49 基于 schema 文件 的 查询 结果 图 8-50 不 指定 schema 文件 的 查询 结果 


8.6.4 文本 文件 的 快速 合并 


当 一 个 文件 夹 中 有 大 量 文件 格式 相同 、 内 容 不 同 的 CSV 或 TXT 文件， 很 多 情况 下 需要 
合并 成 一 个 总 体 文件 。 自 然 可 以 使 用 前 面 讲 过 的 查询 CSV 文件 的 方法 ， 逐 一 查询 每 个 文件 ， 
把 结果 记录 集 发 送 到 同一 个 Excel 表 中 。 

这 里 介绍 一 种 利用 Shell 调用 DOS 命令 实现 快速 合并 文件 的 方法 ， 如 图 8-51 所 示 。 通 
常情 况 下 ， 在 命令 提示 符 窗口 中 输入 copy *.csv Total.csv 可 以 把 当前 路 径 下 所 有 的 CSV 文 
件 合并 为 Total.csv 


而 管理 员 : CWindows\system32\emd exe > el"| 


图 8-51 使 用 DOS 命令 快速 合并 csv 文件 


使 用 VBA 调用 上 述 功能 ， 需 要 事先 把 当前 路 径 切换 至 待 处 理 的 CSV 文件 所 在 路 径 ， 
然后 用 Shell 语句 即 可 。 
假设 一 个 文件 夹 下 有 4 个 单独 的 CSV 文件 ， 运 行 下 面 的 程序 可 以 合并 为 一 个 文件 。 


Sub MergeFiles () 
Dim Path As String 
Path = ThisWorkbook.Path & "\CSV" 
ChDrive Left (Path, 2) 
ChDir Path 
Shell "cmd /c copy Score*.csv summary.csv", vbHide 
Application.Wait Now + TimeValue("00:00:01") 
End Sub 


代码 分 析 : VBA 中 的 ChDir 用 于 更 改 当 前 目录 ,但 是 必须 先 用 ChDrive 切换 到 相应 的 
磁盘 分 区 根 目录 才 行 。 

另外 ，Shell 命令 是 异步 执行 的 ， 因 此 最 好 在 Shell 语句 之 后 加 上 必要 的 延 时 。 

运行 上 述 程序 ， 可 以 看 到 文件 夹 中 多 了 一 个 summarycsv， 用 记事 本 程序 查看 其 内 容 ， 
不 仅 写 人 了 每 个 CSV 文件 的 数据 记录 ， 而 且 复制 了 标题 行 ， 如 图 8-52 所 示 。 

如 果 要 查询 上 述 总 体 文件 中 所 有 的 成 绩 记录 ， 可 以 执行 如 下 SQL 查询 命令 。 


Select * From summary.csv Where 学 号 Like "HG%" 
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上 面 讲 过 的 使 用 copy 命令 合并 文件 的 方法 同样 适用 于 扩展 名 为 .txt 的 文本 文件 。 
以 上 内 容 的 源 代码 文件 为 “实例 文档 48.xlsm”。 


名 称 修改 日 期 美 型 大 小 

的 Scorel-7.csv 2018/5/28 20:52 Microsoft Excel .- 1KB 
由 score8-12.csv 2018/5/28 20:35 。 Microsoft Excel .- 1KB 
的 Scorel3-17.csv 2018/5/28 20.52 。 Microsoft Excel .- 1 KB 
后 Scorel8-24.csv 2018/5/28 20:52 Microsoft Excel ... 1KB 
HN summary.csv 2018/5/28 20:53 Microsoft Excel 1KB 


名 summary.csv -记事 本 
ee pS 格式 (O) 查看 (V) 帮助 (H) 
Re 


T， 
和 71 85; 93 
HG201807, 


HG201820; 人 63; 75, 91 


HG201821, ,69, 51, 62 
HG201822, 陶 银 华 , 84, 91, 98 
HG201823, 田 晖 , 52, 85, 85 


图 8-52 自动 合并 多 个 CSV 文件 


8.7 “本章 小 结 


数据 表 由 字段 和 记录 构成 ,字段 就 是 列 名 、 表 头 ， 字 段 对 象 (Field) 的 重要 属性 有 
Name、Type 和 Value。Name 是 字段 的 名 字 ，Type 是 字段 的 数据 类 型 ，Value 是 当前 记录 行 
对 应 的 值 。 

VBA 中 引用 ADODB 对 象 可 以 访问 Access、Excel 工作 表 、 文 本 文件 等 数据 库 ， 查 询 
的 结果 是 一 个 ADODB.RecordSet 对 象 ， 使 用 该 对 象 的 MoveNext 等 方法 实现 记录 行 的 跳 转 ， 
BOF 属性 用 于 判断 游标 是 否 处 于 第 一 行 记 录 之 前 ，EOF 属性 判断 游标 是 否 处 于 最 后 一 行 记 
录 之 后 。 

常用 的 SQL 语句 有 Insert Into、Delete、Update 和 Select。 
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Office VBA 混合 编程 


微软 Office 的 很 多 组 件 ， 与 Excel VBA 一 样 ， 都 支持 VBA 编程 。 一 般 情 况 下 每 个 组 件 
的 VBA 编程 所 操作 的 是 对 应 组 件 的 对 象 模型 ， 微 软 公 司 提供 的 OLE 自动 化 技术 ， 可 以 通过 
一 个 应 用 程序 来 控制 另外 应 用 程序 ， 例 如 可 以 在 Excel VBA 中 对 Word 的 对 象 进行 读 写 。 

Office VBA 的 跨 组 件 编程 使 得 不 同 组 件 的 数据 可 以 在 同一 个 程序 中 共享 使 用 。 同 时 ， 
跨 组 件 编程 也 是 使 用 其 他 语言 进行 Office 开发 的 基础 ， 具 体 关系 如 图 9-1 所 示 。 


图 9-1 多 种 语言 可 以 访问 Office 对 象 


本 章 首 先 介绍 前 期 绑 定 和 后 期 绑 定 ， 然 后 介绍 应 用 程序 对 象 的 获取 和 创建 ， 最 后 讲述 几 
个 不 同 组 件 互相 访问 的 实例 。 


9.1 前 期 绑 定 和 后 期 绑 定 


严格 地 讲 ， 操 作 其 他 组 件 与 绑 定 与 否 没什么 关系 。 所 谓 的 前 期 绑 定 ， 就 是 在 写 程序 之 
前 ， 把 被 控 组 件 的 对 象 模型 引入 主 控 程 序 的 工程 中 。 
假设 在 Excel VBA 中 访问 Word 对 象 ， 那 么 主 控 程 序 就 是 Excel， 被 控 组 件 是 Word。 此 
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时 的 前 期 绑 定 就 是 向 Excel VBA 的 工程 中 添加 Word ee 
在 Excel VBA 的 代码 窗口 中 ,， 单 击 【 工 具 / 引 用 】， 


”Microsoft Word 15.0 Object 
Library”， 然 后 单 击 “ 确 定 ” 按 钮 ， 如 图 9-2 所 示 。 


引用 -VBAProject LS | 
可 使 用 的 引用 忆 ) : 确定 
器 ft Wind Defender COM Vti- ^ 用 
Dierosoft Yindors Iaage Acemisitia 一 卫 | 


DMicrosoft Windows Installer Object 


Microsoft Windows Media Player Net, 浏览 中. 
OMierosoft Windows Wedia Player Nets 


i WinHITP Services, versioy 全 
pti 


Nicrosoft Word 15.0 Object Library 
定位 : 
语言 : 标准 


C:\Program Files\Microsoft Office\OfficelS\MSWORD. 


图 9-2 Excel VBA 工程 中 添加 Word 对 象 的 引用 


9.1.1 绑 定 前 后 的 变化 


添加 了 被 控 组 件 的 对 象 库 后 ， 书 写 代码 时 ， 可 以 声明 被 控 组 件 的 对 象 变量 类 型 ， 也 可 以 
在 程序 中 使 用 被 控 组 件 的 枚 举 常 量 。 


向 Excel VBA 添加 Word 对 象 库 后 ， 可 以 声明 Word 方面 的 对 象 类 型 


， 也 可 以 使 用 Word 
对 象 库 中 的 枚 举 常量 ， 如 图 9-3 所 示 。 


承 Microsoft Visual Basic for Applications -实例 文 苞 49xlsm - 晶 人 Word 
人 20 wa RD ND WO Rt) EF TAD Ha EP WR 


国 加 -回避 二 拆 Pm，na 凡 人 2 O 行 3, 列 28 | EEE 
aoe 国 [ED = 


Sub Test1() 


Dim wbk As Workbook, doc As Word.Document 
MsgBox Word. Te Ww 
End Sub 


图 9-3 Excel VBA 中 可 以 使 用 Word 的 枚 举 常量 
例如 ， 运 行 上 述 Testl 过 程 ， 弹 出 的 对 话 框 中 显示 5 (wdGoToEndnote 等 于 5 )。 
被 控 对 象 库 添加 进来 以 后 ， 对 象 浏览 器 中 会 看 到 有 新 增 的 对 象 。 在 Excel VBA 中 按 下 


F2 键 ， 组 合 框 中 选择 “Word” 和 “Document” 并 按 回 车 键 ， 就 可 以 看 到 被 控 组 件 的 对 象 模 
型 和 枚 举 常 量 ， 如 图 9-4 所 示 。 


现在 取消 勾 选 VBA 工程 中 的 Word 引用 ， 再次 运行 上 述 过 程 ， 将 出 现 “ 编 译 错误 ”， 如 
图 9-5 所 示 。 
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垃 文件 四。 坊 生 旧 视 加 WV) 插入 格 KO) 调 R(D) 运行 R) 工具 四 外 尘 程 序 和 内 瘟 DD 帮助 由 -日 x 
国 国 -器 | 关 名 区 装 | OI》n 忆 | 导 国 认 关 :三 入 


图 9-4 在 对 象 浏览 器 中 查看 外 部 引用 库 中 的 成 员 


Sub Test1() 

Dim wbk As Workbook er 
MsgBox Word. WdGoToItem. wdGoTol ndnote 

End Sub 


图 9-5 不 进行 前 期 绑 定 就 不 能 使 用 对 象 库 
可 以 看 出 ， 不 使 用 前 期 绑 定 ， 就 无 法 使 用 被 控 组 件 的 对 象 类 型 和 枚 举 常量 。 


9.1.2 ”后 期 绑 定 方式 


后 期 绑 定 方式 ， 指 的 是 不 添加 被 控 组 件 的 对 象 库 ， 对 象 变量 需要 声明 为 Object 类 型 ， 
枚 举 常 量 使 用 对 应 的 整 型 值 。 

例如 ， 在 Excel VBA 中 ,下 面 的 程序 的 作用 是 获取 Word 应 用 程序 ， 自 动 创建 一 个 文 
档 ， 并且 写 入 内 容 。 


Sub Testl () 
Dim wordApp As Object, doc As Object 
Set wordApp = GetObject(, "Word.Application") 
Set doc = wordApp.Documents.Add() 
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doc.Content.InsertAfter Text:="Hello,Excel VBRI" 
End Sub 


由 于 后 期 绑 定 方式 没有 把 被 控 对 象 引 入 工程 中 ， 因 此 存在 诸多 不 便 。 


9.2 创建 和 获取 应 用 程序 对 象 


如 果 被 控 应 用 程序 还 没有 运行 ， 可 以 通过 主 控 程序 创建 被 控 应 用 程序 的 对 象 。 被 控 程 序 
的 应 用 程序 对 象 也 是 被 控 程 序 的 顶级 对 象 ， 例 如 Word、PowerPoint、Outlook 等 也 都 有 相应 
的 Application 对 象 。 

其 实 不 管 是 哪 一 个 组 件 的 VBA， 只 有 通过 Application 对 象 才能 访问 到 其 他 对 象 ， 因 此 
跨 Office 组 件 VBA 编程 必须 先 创建 或 获取 被 控 组 件 的 应 用 程序 对 象 ， 才 能 进一步 访问 。 

CreateObject 用 于 创建 一 个 新 的 应 用 程序 对 象 ，GetObject 用 于 获取 已 经 在 运行 的 应 用 程 
序 对 象 。 


9.2.1 使 用 CreateObject 


下 面 的 程序 使 用 CreateObject 创建 一 个 新 的 Word 应 用 程序 。 


Sub Test2 1() 
Dim WordApp Rs Object 
Set WordApp = CreateObject (Class:="Word.Application") 
With WordApp 
Visible = True 
:Documents.Add 
End With 
End Sub 
代码 分 析 : CreateObject(Class:="Word.Application") 用 来 创建 一 个 新 对 象 ,“ Word. 
Application” 是 存储 于 注册 表 中 的 类 名 ， 如 果 计 算 机 中 没有 安装 Word 组件 ， 那 么 该 代码 会 
创建 失败 。 
运行 上 述 Excel VBA 过 程 ， 可 以 看 到 桌面 上 自动 启动 Word 应 用 程序 ， 并 且 自 动 创建 了 


一 个 空白 文档 。 
9.2.2 ”使 用 New 关键 字 


使 用 New 来 创建 新 应 用 程序 对 象 时 ， 必 须 采用 前 期 绑 定 方式 。 下 面 的 过 程 自动 创建 一 
个 新 的 Word 应 用 程序 ,并且 设置 该 应 用 程序 可 见 ， 窗 体 状态 为 最 大 化 。 


Sub Test3 1() 
Dim WordApp As Word.Application 
Set WordApp = New Word.Application 
With WordApp 
-Visible = True 
-WindowState = Word.WdWindowState.wdWindowSstateMaximize 
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End With 
End Sub 


9.2.3 ”获取 正在 运行 的 应 用 程序 对 象 


与 CreateObject 相对 应 的 是 GetObject， 该 函数 可 以 获取 已 经 运行 的 应 用 程序 ， 也 就 是 
并 不 创建 新 对 象 。 
下 面 的 过 程 获取 正在 运行 的 Word， 并 打印 出 当前 Word 打开 的 文档 个 数 。 


Sub Test4() 
Dim WordApp As Word.Application 
Set WordApp = GetObject(, Class:="Word.Application") 
With WordApp 
Debug.Print " 打开 的 文档 个 数 : "， .Documents.Count 
End With 
End Sub 


代码 分 析 : 需要 注意 的 是 ，GetObject 括号 内 有 一 个 半角 逗号 。 
如 果 被 控 对 象 并 未 运行 ， 则 会 出 现 “运行 时 错误 429” 提 示 。 
例如 ， 下 面 的 Excel VBA 代码 尝试 获取 正在 运行 的 PowerPoint。 


Sub Test5() 
Dim PowerPointApp As PowerPoint.Application 
Set PowerPointApp = GetObject(, Class:="PowerPoint.Application") 
With PowerPointApp 
.WindowState = PowerPoint.PpWindowState.ppWindowMaximized 
End With 
End Sub 


由 于 事先 没有 打开 PowerPoint， 所 以 运行 到 GetObject 那 行 时 弹出 错误 ， 如 图 9-6 所 示 。 


Microsoft Visual Basic 


运行 时 潮 误 “429 
Activex 部 件 不 能 创 寻 对象 


帮助 中 


维 符 C) | 结束 E) | | 通过 曾 : 


图 9-6 获取 不 到 相应 的 应 用 程序 


如 果 已 经 打开 PowerPoint， 运 行 上 述 过 程 则 没 问 题 。 
GetObject 除了 可 以 获取 应 用 程序 外 ， 还 可 以 用 于 获取 磁盘 中 未 打开 的 文档 。 运 行 下 面 
的 过 程 时 ， 在 Excel 中 并 不 会 看 到 文档 被 打开 ,但 是 这 个 文档 的 Bl 单元 格 会 被 修改 。 
Sub 后 台 打 开 Excel 文件 () 
Dim wbk As Excel .Workbook 


Set wbk = GetObject("C:\temp\333.xlsx") 
wbk.Worksheets ("Sheet1") .Range ("B1") .Value = "Happy" 
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wbk.Save 

wbk.Close 

Set wbk = Nothing 
End Sub 


当然 也 适用 于 其 他 Office 组 件 ， 下 面 的 过 程 后 台 打开 Word 文档 ， 并 且 删 除 文档 中 的 第 


2 段落 ， 然 后 保存 并 关闭 文档 。 

Sub 后 台 打 Word 文 件 () 
Dim doc Rs Word.Document 
Set doc = Getobject("C:\temp\ 新 员工 入 职 须 知 .doc") 
doc.Paragraphs (2) .Range.Delete 
doc.Save 
doc.Close 
Set doc = Nothing 

End Sub 


9.3 代码 改写 技巧 


跨 组 件 的 VBA 编程 ， 重 点 和 难点 是 现 有 代码 的 移植 和 重 写 ， 特 别 是 以 前 一 直 使 用 单 组 
件 编程 ， 会 养 成 很 多 简写 的 习惯 ， 那么 在 使 用 跨 组 件 编程 时 就 需要 改 掉 这 些 习惯 。 
那么 如 何 把 单 组 件 的 VBA 代码 修改 成 可 以 在 其 他 组 件 中 运行 的 代码 呢 ? 需要 注意 的 有 
以 下 后 
口 声明 被 控 组 件 的 对 象 变量 时 ， 使 用 完全 路 径 ， 而 不 是 简写 形式 。 
口 使 用 被 控 组 件 的 枚 举 常 量 时 ， 使 用 完全 路 径 。 
口 被 控 组 件 的 应 用 程序 对 象 不 能 直接 使 用 Application， 而 是 使 用 CreateObject 或 
GetObject 来 获得 。 
口 被 控 组 件 中 用 到 的 对 象 尽量 从 被 控 组 件 的 Application 对 象 写 起 ， 而 不 是 简写 形式 。 
口 被 控 组 件 用 到 的 CodeName， 例 如 ThisWorkbook、Sheetl 等 ， 在 主 控 程序 中 不 识别 ， 
需要 改写 为 其 他 形式 。 


9.3.1 Word VBA 中 运行 Excel VBA 代码 


假设 Excel 文件 中 有 如 下 一 个 VBA 过 程 。 


Public Sub Test61() 
Dim wbk As Workbook, wst As Worksheet 
Set wbk = ThisWorkbook 
Application.DisplayAlerts = False 
Sheet3.Delete 
Set wst = wbk.Worksheets.Add (Before:=Sheet2, Type:=xlWorksheet) 
wst.Name = Format (Date, "YYYYMMDD") 
wst.Range ("B2:D5") .Select 
Selection.Interior.Color = vbBlue 
End Sub 
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上 述 代 码 是 Excel VBA 中 非常 普通 的 一 个 宏 ， 功 能 是 首先 删除 CodeName 为 Sheet3 的 
工作 表 ， 然 后 向 Sheet2 之 前 添加 一 个 新 工作 表 ， 并 赋 给 变量 wst， 重 命名 工作 表 为 当前 日 
期 ， 最 后 选择 一 个 单元 格 区 域 ， 涂 上 背景 色 。 

如 果 把 上 述 过 程 原封 不 动 复制 到 Word VBA 中 ,还 能 够 正常 运行 吗 ? 

下 面 启动 Word 2013， 新 建 一 个 文档 ， 另 存 为 “实例 文档 49.docm”， 打 开 Word VBA 
编程 界面 ， 然 后 插入 一 个 标准 模块 。 

由 于 要 从 Word VBA 访问 Excel 对 象 ， 因 此 需要 添加 对 Excel 的 外 部 引用 ， 如 图 9-7 
所 示 。 


i 
EN 


可 使 用 的 引用 以 ) [| 
Visual Basie For Applications 取消 
SE Word 15.0 Object Duy 身 CB] 
MOLE Automation 
回 ja 浏览 8). .。 
Gh Office 15 0 Object Libran 
li erosoft Excel 14.0 Dbiest Librar + 
日 ]0fficeD11 人 如 
了 1 ay 
pr 1.0 Type Lib 帮助 00 
DAccountProtect 1.0 Type Library 各 
口 Acrobat 
口 Aerobat Access 3.0 Type Library 
口 Aerobat Distiller 长 
门 jerohai Sesn LN Tne Iiheerw 
有 erosoft Excel 14.0 Object Library 
定位 : C:\Progran Files\Microsoft 0ffice\0ffice2010\0ffi 
语言 : 标准 


图 9-7 Word VBA 中 添加 Excel 的 引用 


然后 把 Excel VBA 中 的 Test6 过 程 复 制 到 Word VBA 的 标准 模块 中 运行 。 运 行 肯定 不 成 
功 ! 因为 需要 改写 。 
按照 前 面 讲 过 的 5 条 改写 原则 ， 修 改 为 如 下 的 Word VBA 过 程 。 


Public Sub Test6() 
Dim ExcelApp As Excel.Application 
Dim wbk As Excel.Workbook, wst As Excel.Worksheet 
Set ExcelApp = GetObject(, "Excel.Application") 
Set wbk = ExcelApp.ActiveWorkbook 
ExcelApp.DisplayAlerts = False 
wbk.Worksheets (3) .Delete 
Set wst = wbk.Worksheets.Add (Before:=wbk.Worksheets (2), Type:=Excel.XlSheet 

Type.xlWorksheet) 

wst.Name = Format (Date, "YYYYMMDD") 
wst.Range ("B4:D3") .Select 
ExcelApp.Selection.Interior.Color = vbRed 

End Sub 


代码 分 析 : 由 于 Excel 此 时 变 成 了 被 控 程序 ， 因 此 需要 创建 一 个 ExcelApp 应 用 程序 对 
象 ， 而 不 是 直接 使 用 Application， 此 时 的 Application 是 主 控 程序 Word。 

原先 的 ThisWorkbook 需要 改写 为 ExcelApp.ActiveWorkbook。 

原先 的 Type:= x1Worksheet 需要 改写 为 Type:=Excel XISheetType.xlWorksheet， 也 就 是 尽 
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量 从 被 控 程 序 的 对 象 库 名 称 开始 写 ， 而 不 是 简写 。 

在 最 后 一 行 代码 中 ， 原 先 的 Selection 需要 在 前 面 添加 ExcelApp.。 因 为 Selection 在 此 
处 有 歧义 ，Word 也 有 Selection 对 象 。 

再 次 运行 修改 后 的 Test6 过 程 ， 可 以 发 现 Word VBA 成 功 修改 了 Excel 这 边 的 内 容 。 


9.3.2 ”处 理 被 控 组 件 的 事件 过 程 


Excel VBA 的 很 多 对 象 都 支持 事件 编程 ， 例 如 Excel VBA 中 的 Application 、Workbook、 
Worksheet 都 支持 很 多 事件 。 
假设 工作 表 Sheetl 后 面 创建 有 如 下 SelectionChange 事件 。 
Private Sub Worksheet SelectionChange (ByVal Target As Range) 
Target .Interior.Color = vbGreen 


Application.statusBar = Target.Address 
End Sub 


那么 当 鼠 标 选中 单元 格 区 域 时 ， 该 区 域 会 变 绿 ， 同 时 可 以 看 到 Excel 的 状态 栏 里 显示 了 
所 选区 域 的 地 址 。 

那么 以 上 这 个 事件 过 程 能 不 能 改写 到 其 他 Office 组 件 中 ， 也 就 是 让 其 他 组 件 能 够 感知 
Excel 这 边 的 动作 呢 ? 

下 面 讲解 一 下 ， 在 PowerPoint VBA 创建 Excel 的 工作 表单 元 格 区 域 的 选择 事件 。 

启动 PowerPoint 2013， 新 建 一 个 演示 文稿 ， 男 存 为 “实例 文档 50.pptm”。 打 开 
PowerPoint 的 VBA 编辑 器 ， 单 击 【 工具 /引用 ]， 添 加 对 Excel 的 外 部 引用 。 

然后 向 该 演示 文稿 的 VBA 工程 添加 一 个 类 模块 ， 重 命名 为 ExcelEvent， 类 模块 中 的 代 
码 如 下 。 


Public WithEvents WST As Excel.Worksheet 


Private Sub WST SelectionChange (BYVal Target Rs Excel.Range) 
Target .Interior.Color = vbRed 
Application.RActivePresentation.Slides(1) .Shapes (1) .TextFrame.TextRange. 
Text = Target.Address (False, False) 
End Sub 


代码 分 析 : WST 是 一 个 带 有 事件 的 对 象 ， 当 选中 区 域 后 ， 区 域 会 变 红 ， 而 且 第 1 张 纪 
灯 片 的 第 一 个 文本 框 会 显示 所 选 Excel 单元 格 的 相对 地 址 。 

接 下 来 需要 对 上 述 类 进行 实例 化 。 

向 PowerPoint VBA 再 添加 一 个 标准 模块 ， 重 命名 为 Modulel ， 然 后 书写 如 下 代码 。 


Public Instance As New ExcelEvent 


Public ExcelApp As Excel.Application 


Public Sub Main() 
Set ExcelApp = GetObject(, "Excel.Application") 
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Set Instance.WST = ExcelApp.ActiveSheet 
End Sub 


代码 分 析 : Instance 是 对 ExcelEvent 的 一 个 实例 ， 需 要 在 Main 过 程 中 把 Instance 的 
WST 与 运行 中 的 Excel 当前 工作 表 进 行 关联 。 

代码 写 好 后 ， 手 动 运行 Main 过 程 ， 选 择 Excel 单元 格 区域 B3:C4 后 ， 该 区 域 背景 色 变 
红 ， 同 时 可 以 看 到 PowerPoint 幻灯 片 中 的 内 容 发 生 相 应 改变 ， 如 图 9-8 所 示 。 


轩 日 9 而 : 实说 50 ppem - PowerPoint ST i 
| = Hi 视 轿 和 I 具 。 h 项 Acrobat 8 sa po 


EE 


B3:C4 


革 击 此 处 添加 副标题 


图 9-8 选择 Excel 单 元 格 导致 PPT 文本 框 内 容 变化 
以 上 实例 演示 了 Worksheet 对 象 的 事件 过 程 的 移植 ， 对 于 Application 、Workbook 的 事 
件 ， 也 可 以 用 上 述 方法 实现 ,读者 自行 尝 i 
VBA 代码 移植 到 其 他 组 件 就 实现 了 Office VBA 的 混合 编程 ， 如 果 把 VBA 代码 移植 到 
VB 或 其 他 语言 中 ， 代 码 被 真正 地 保护 了 起 来 ， 就 是 VBA 的 封装 技术 了 。 关 于 封装 技术 ， 
本 书 暂 不 讨论 。 


9.4 ” 跨 组 件 编程 实例 


Office 跨 组 件 编程 ， 能 够 把 不 同 组 件 的 数据 、 对 象 整 合 到 一 个 程序 中 ， 多 个 Office 组 件 


之 间 实 现 数据 共享 ， 因 而 意义 非常 重大 。 然 而 跨 组 件 编程 的 水 平 高 低 ， 仍 然 取 决 于 单 组 件 的 
VBA 对 象 模型 的 理解 程度 。 


9.4.1 Word VBA 调用 Excel 工作 表 函 数 实 现 英 汉 互 译 


Excel 2013 的 新 增 工 作 表 函 数 可 以 进行 中 英文 互 译 ,现在 Word 文档 中 有 一 些 单词 需要 


形 ” office VBA 开发 经 典 一 中 级 进 阶 郑 


翻译 ， 这 就 需要 借用 Excel 的 功能 来 完成 。 
“实例 文档 51.docm” 这 个 Word 文档 包含 一 个 表格 ,表格 的 第 1 列 是 一 些 词汇 , 第 2 列 
是 空白 的 ， 准 备 把 翻译 的 结果 放 入 第 2 列 ， 如 图 9-9 所 示 。 


生日 DD 有 种 芝 交 昨 启 -学 国 *» 实例 文档 51.docm - Word 雪 局 工具 
| = Fe 和 me 3 用 tf 网 。 视 四 开 RT 具 。 jn 项 讼 | 。 布局 


benefit» 


promoter 
预定 。 


equity? » | 


Chinae 所 le 
调查 。 

billione 
improver 


rural? 
教育 » 


facilities? 


strengthene 


Turalw 
强制 


educatione 


central» 
西部 。 


regionse 


fundse 


usedn 


图 9-9 需要 翻译 的 词汇 
接 下 来 创建 一 个 Excel 工作 短 “ 翻 译 模板 .xlsm”， 在 其 单元 格 Bl 输入 一 个 公式 : 


=FILTERXML (WEBSERVICE ("http://fanyi.youdao.com/translate?&i="&Al&"&doctype=xml 
&version"),"//translation") 


这 个 公式 的 作用 是 翻译 单元 格 Al 的 内 容 ， 如 图 9-10 所 示 。 


[Se 
| 


六 v £ | -FILTER (VEESERVICE 


i 
到 学 习 learning 


图 9-10 ”Excel 中 的 翻译 函数 
只 要 修改 单元 格 Al 的 内 容 ，B1 会 自动 变 为 其 对 应 的 译文 。 
接 下 来 在 Word VBA 中 创建 如 下 过 程 ， 实 现 原理 是 把 Word 表格 中 每 一 个 词汇 依次 发 送 
到 Excel 的 Al 单元 格 中 ， 待 其 翻译 完毕 后 ， 再 把 Excel 的 B1 单元 格 译文 发 送 回 Word 表格 
第 2 列 中 。 
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Sub Translate() 
Dim ExcelApp As Excel.Application 
Dim i As Integer 
Dim table As Word.table “ 声明 一 个 Word 表格 对 象 
Set ExcelApp = GetObject(, "Excel.Application") "获取 运行 中 的 Excel 
Set table = Application.ActiveDocument.Tables (1) 'table 表示 文档 中 第 1 个 表格 
With ExcelApp 
For i = 1 To table.Rows.Count ' 遍历 Word 表格 的 行 ， 从 第 1 行 到 最 末 行 
Debug.Print table.Cell (i, 1).Range.Text 
-Range ("Al1") .Value = table.Cell (i, 1) .Range.Text 
' 把 Word 表格 第 立行 、 第 1 列 内 容 发 到 EExcel 的 Al 单元 格 
table.Cell (i, 2).Range.Text = .Range("B1") .Value 
' 把 Excel 的 Bl 单元 格 (翻译 结果 ) 发 送 到 Word 表 格 第 工行 、 第 2 列 
Next i 
End With 
End Sub 


运行 上 述 过 程 ， 可 以 看 到 “实例 文档 51.xlsm ”表格 的 第 2 列 自动 填充 完毕 ， 如 图 
9-11 所 示 。 


[= 实例 文档 51.docm - Word 囊 格 T 具 
| = EEE 
[8 
加 打开 民 另 为 区 页 设置 四 Word 迁 项 避 运 行 安 门 区 基板 关 让 定义 全 恕 四 复制 文本 | 大 由 ”四 
回 量 kf 需 97-2003 区 打印 预 训 二 模 柜 j0 载 项 的 录制 去 | 分隔 答 的 查找 苦 搞 名 清除 格式 9 
利用 命令 葬 贴 板 
图 
benefit» 好 处 » 加 
promoter 促进 » | 
预定 。 reservatione | 
equityw 股本 。 P 
Chinan 中 国 。 PP 
调查 。 surveyr 站 
billione 欧元 » » 
improve 改善 P 
rural? 农村 » 日 
教育 education。 » 
facilities» 设施 » P 
strengthen» 加 强 » ° 
rural» 农村 = |: 
强制 mandatory? | 
educatione 教育 。 » 
central? 中 央 。 » 
西部 » In thewestr | 
regions» 地 区 。 站 
fundso 基金 " | 
used? 使 用 加 


图 9-11 借助 Excel 的 翻译 功能 翻译 Word 表格 内 容 


9.4.2 PowerPoint VBA 调用 Excel VBA 实现 自动 计算 


Excel VBA 中 Application 的 Evaluate 可 以 对 表达 式 进 行 求 值 。 例 如 Application. 
Evaluate("30-8/2") 就 可 以 返回 26。 
利用 这 个 特点 ， 可 以 把 这 个 计算 功能 引入 PowerPoint 中 ， 在 幻灯 片上 放 入 两 个 文本 框 ， 


各 office VBA 开发 经 典 一 中 级 进 阶 郑 


一 个 用 来 输入 表达 式 ， 另 一 个 用 于 存放 计算 的 结果 。 
单 击 PowerPoint 的 【开发 工具 /控件 ]， 把 一 个 CommandButton 放 在 幻灯 片上 ， 并 且 把 
该 命令 按钮 的 标题 改 为 “计算 ”， 如 图 9-12 所 示 。 


-0 ET 3 梧 
mR HR 市 有 NW | F&IR | I Mercbat 


| 
国 “外 是 3 日 寺 外 


和 
着 se 


30+98/2-(20+3)*2 


计算 | 


单 击 此 处 添加 副标题 


图 9-12 PowerPoint VBA 设计 
然后 双击 该 命令 按钮 ， 编 写 其 Click 事件 。 


Private Sub CommandButton1l Click() 
Dim ExcelApp Rs Excel .Application 
Dim result As Double 
Set ExcelApp = GetObject(, "Excel.Application") 
result = ExcelApp.Evaluate (Application.ActivePresentation.Sslides(1) .Shapes (1). 
TextFrame.TextRange.Text) 
Application.ActivePresentation.Sslides (1) .Shapes (2) .TextFrame.TextRange.Text = 
result 
Set ExcelApp = Nothing 
End Sub 


代码 分 析 : 对 于 PowerPoint VBA, 文本 框 也 是 幻灯 片上 的 Shape 对 象 ， 因 此 使 用 
Shapes(1).TextFrame.TextRange.Text 得 到 第 一 个 文本 框 的 内 容 ， 使 用 Excel VBA 的 Evaluate 
方法 对 其 求 值 ， 把 result 返回 到 第 二 个 文本 框 中 。 

写 好 如 上 代码 后 ， 让 幻灯 片 进 入 放映 模式 ， 点 击 “ 计 算 ” 按 钮 ， 可 以 看 到 自动 返回 计算 
结果 ， 如 图 9-13 所 示 。 


30+98/2-(20+3)*2 


8 


图 9-13 借助 Excel VBA 的 Evaluate 自动 计算 表达 式 的 值 
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9.4.3 Outlook VBA 基于 Excel 数据 发 送 邮 件 

利用 Outlook VBA 可 以 方便 地 进行 自动 收发 邮件 ， 如 果 以 Excel 工作 表 数 据 作为 数据 
源 ， 可 以 实现 批量 发 送 邮件 。 

首先 在 Excel 中 创建 基础 数据 ， 假 设 要 给 多 个 面试 人 员 发 邮件 ， 如 图 9-14 所 示 。 


日 9- ee- 部 件 模板 xjsm - Excel Ts CX 
| == rm 斌 两 刘 和 TIR 本 le 
FB ~]| 国 |x v £ > 
A B c D EE 

1 | 收 件 人 主题 正 附件 


2 vflyf7159sina, con | 面试 通知 很 抱 鞭 ， 您 没有 通过 这 次 面试 。 
326693159ga. con 面试 通知 您 好 ! 葵 喜 您 通过 面试 ， 请 于 下 周一 报到 ! |c:\tenp\ 新 员工 入 职 须知 . doc 


Sheet1 | Sheet2 | Sheet3 ® gl D 
SF 四 - + + 


图 9-14 用 于 发 送 邮 件 的 基础 数据 
然后 在 Outlook 中 打开 VBA 编程 界面 ， 插 入 一 个 标准 模块 ， 并 添加 对 Excel 对 象 库 的 
引用 。 
标准 模块 中 的 代码 如 下 。 


Sub 批量 发 信 () 
Dim ExcelApp As Excel.Application 
Dim Mail As Outlook.MailItem 
Dim i As Integer 
Set ExcelApp = GetObject(, "Excel.Application") 
For i=2 To03 
Set Mail = Application.CreateItem(ItemType:=Outlook.0lItemType .olMailItem) 
With Mail 
.To = ExcelApp.Range ("A" & i) .Value 
.Subject = ExcelApp.Range ("B" & i).Value 
.Body = ExcelApp.Range ("C" & i).Value 
IE IsEmpty (ExcelApp.Range("D" & i)) = False Then 
.Attachments.Add ExcelApp.Range("D" & i).Value 
End If 
". Display 
.Send 
End With 
Next i 
End Sub 


代码 分 析 : Outlook 的 MailItem 代表 一 封 邮件 ， 属 性 To、Subject、Body、Attachment 
分 别 代表 邮件 的 收 件 人 、 主 题 、 正 文 、 附 件 。 

运行 上 述 过 程 ， 从 Outlook 的 已 发 送 邮件 可 以 看 到 发 出 去 的 邮件 ， 当 然 面 坛 人 员 的 收 件 
箱 也 能 收 到 这 些 邮件 ， 如 图 9-15 所 示 。 


现 ， office VBA 开发 经 典 一 中 级 进 阶 郑 


中 时 与 Bef - 19488012@qq.com - Outlook 
| = i 
园 轩 | 国画 
及 二 全 性 COM 禁用 项目 | 选择 表单 设计 窟 休 
jn 项 记 定 义 窗 休 
ET | HR -| 仙人 QE 外 转生 
全 全 部 未 读 按 日 期 最 新 上 2018/2/25 嘻 日 ) 17:42 
S480 2 Ogtom | Fe 19488012 <19488012@qq.com> 
收 们 镇 11 "lyfiyf715@sina.com' 而 二 知 
汪汪 ee T742 收 人 4 人 
已 发送 邮件 很 抱 职 ， 符 没有 通过 这 次 面 坛 。 < 结 率 > 
古本 二 和 I 和 RB.doc (54 KB) 

BNApft ‘32669315@qq.com 和 La 全 
Rss 源 1742 
发 件 箱 二 ! 拉 吉 必 表 过 而 二， 请 于 下 导报 到 . 
a 入 好 ! 蕉 喜 你 通过 面 坛 ， 请 于 下 周一 报 到 ! 

'32669315@qq.com" 
搜索 文件 赤 test 17:24 

4 三 周 前 

'32669315@qq.com' 和 

Hello img 2018/2/5 

VBA 自 动 创建 HTML 的 table name age 


图 9-15 批量 发 送 邮件 
9.4.4 Visual Basic 6.0 读 写 Excel 


Visual Basic 6.0 也 可 以 方便 地 操作 访问 微软 Offce， 下 面 的 实例 把 VB 窗 体 中 的 数据 发 
到 Excel 单元 格 中 。 
启动 Visual Basic 6.0， 创 建 一 个 应 用 程序 项 目 ， 窗 体 上 放置 一 个 Text 控 件 ， 用 于 


输入 起 始 路 径 ， 再 放 一 个 File 控件 ， 用 来 自动 显示 该 路 径 下 的 所 有 文件 名 称 ， 再 放 一 个 
Command 命令 按钮 ， 如 图 9-16 所 示 。 


Ve Excel - Microsoft Visual Basic [RH] - Ve_Excel - Forni Fon) 0 本 | 
和 文件 四 编辑 {E) 视图 (V) 工程 (P) 格式 (QO) 调 坛 (D) 运行 (R) 查询 (U) 图 表 四 工具 QD 外 接 程序 (A) 窗口 (W) 帮助 (H) 


| 区 -所 -机 | 仿 轩 | 弗 息 外 | 呈 必 Te 对 轩 名 等 天 对 儿 | 和 oo 型 4740 x 4590 


General bs TY 
A 固 人 A | EnEhessgipa 
| ;|34. spe 


[Ey] 
ps 国 
国 su 站 
贡 旺 口 
国 四 、 
回 叶 量 


图 9-16 VB6 中 的 窗 体 设计 视图 
程序 的 意图 是 ， 把 File 控件 列 出 的 文件 名 称 发 送 到 Excel 单元 格 中 。 
因此 ， 单 击 VB 6.0 的 菜单 【工程 /引用 ]， 添 加 对 Excel 的 引用 。 


然后 双击 窗 体 中 的 “发 送 到 Excel” 按 钮 ， 进 入 Forml 的 代码 窗口 ， 输 入 Form 的 Load 
事件 ， 以 及 按钮 的 Click 事件 。 
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Private Sub Commanqdl Click() 
Dim ExcelApp As Excel.Application 
Dim i As Integer 
Set ExcelApp = GetObject(, "Excel.Application") 
ExcelApp .Workbooks .Add 
For i = 0 To Me.Filel.ListCount - 1 
ExcelApp.Wait Now + TimeValue ("00:00:01") 
Me.Filel.ListIindex = i 
ExcelApp.Range ("A" & i + 1) .Value = Me.Filel.List (i) "Excel 的 行 号 从 1 开始 ， 所 以 +1 
Next i 
End Sub 


Private Sub Form Load () 
Me.Filel.Path = Me.Text1l.Text 
End Sub 


启动 窗 体 后 ， 单 击 “ 发 送 到 Excel” 按钮 ， 会 看 到 隔 一 秒 就 发 送 一 条 数据 到 Excel 的 A 
列 中 ， 如 图 9-17 所 示 。 


围 日 9- 0-+ 画 二 日 区 
| = Eee 和 四 和 卫 ITR 可 Ee | 


让 vi[x v £] aftertzt v 


EE 
a 


CachescQipu. vbp 
CachessQipu, vby 
12 [cnchessQipu205S. exe 


sheet [ Sheet2 | Shee3 | 加 I ] 


回回 - 


图 9-17 VB 程序 中 的 数据 自动 发 送 到 Excel 单元 格 中 
以 上 案例 的 工程 源 代码 为 “VB 操作 Excel/VB_Excel.vbp”。 


9.5 ”本章 小 结 


前 期 绑 定 不 是 必需 的 ， 即 使 在 VBA 工程 中 不 添加 引用 ， 也 能 实现 程序 同样 的 功能 和 结 
果 。 然 而 ， 不 添加 引用 的 情况 下 ， 书 写 代码 非常 不 方便 ， 所 有 对 象 均 需 声明 为 Object， 而 不 
是 具体 的 对 象 类 型 ， 而 且 不 能 使 用 外 部 引用 中 的 常量 。 

GetObject、New 、CreateObject 用 于 获取 和 创建 外 部 对 象 ， 从 而 达到 调用 其 他 Office 组 
件 的 目的 。 


第 10 章 


工程 引用 与 外 部 对 象 


本 章 介绍 使 用 VBA 遍历 、 读 写 VBA 工程 中 引用 的 方法 。 


本 章 用 到 的 外 部 引用 和 重要 对 象 : 


口 1Microsoft Visual Basic for Applications Extensibility 5.3 


VBIDE.Reference 
> VBIDE.VBProject 


10.1 处理 VBA 工程 中 的 引用 


VBA 程 序 是 以 工程 (VBProject) 为 单位 的 ， 对 于 
Excel VBA， 一 个 工作 短 有 有 上 且 只 有 一 个 独立 的 VBA 工程 ， 
一 个 工程 下 面 由 普通 模块 、 类 模块 、 窗 体 等 构成 ， 可 以 通 
过 VBA 编程 环境 的 工程 资源 管理 器 窗 格 看 到 ， 如 图 10-1 
所 示 。 

每 个 VBA 工程 有 一 个 引用 集合 ( References)， 可 以 单 
击 VBA 编程 环境 的 菜单 【工具 /引用 ]， 弹 出 引用 对 话 框 ， 
引用 对 话 框 中 最 上 面 的 并 且 处 于 勾 选 状态 的 就 是 当前 工程 
的 引用 集合 。 

实际 上 ，VBA 允许 通过 程序 代码 的 方式 来 访问 VBE 
中 的 各 个 VBA 工程 ， 以 及 VBA 工程 中 的 各 个 引用 。 例如 ， 
运行 如 下 两 行 代 码 。 


Msgbox Application.VBE.VBProjects.Count 


合 ] Microsoft Visual Basic for Applications - Group | 
四 文件 日 、 编 纺 (E) 视图 V) 插入 格式 (O)| 
加- 回 |% 的 | bp un 


图 ] Sheetl (Sheetl) 
因 ] Sheet2 (Sheet2) 


Sheet3 (Sheet3) 
Thishorkbook 


-VBAProject 
YBAProject 工程 


Wk 


图 10-1 VBA 工程 资源 管理 器 


Msgbox Application.VBE.ActiveVBProject.References.Count 


结果 弹出 “运行 时 错误 1004” 错 误 对 话 框 ， 如 图 10-2 所 示 。 
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这 是 因为 Office 的 宏 安 全 性 对 话 框 中 默认 不 勾 
选 “信任 对 VBA 工 程 对 象 模 型 的 访问 "， 如 图 10-3 
所 示 。 

因此 ， 凡 是 涉及 使 用 VBA 操作 VBA 工程 方面 的 、 
VBIDE 对 象 方面 的 ， 必 须 事先 勾 选 上 述 安全 性 选项 。 

为 了 便于 使 用 VBIDE 中 的 对 象 类 型 和 常数 ， 在 操 
作 VBA 工程 的 程序 中 需要 添加 “Microsoft Visual Basic 
for Applications Extensibility 5.3”， 如 图 10-4 所 示 。 


运行 时 错误 '1004': 


不 信任 到 Visual Basic Project 的 程序 连接 


信任 中 心 2 | ” 细 -VeAproject 
| mm 本 合用 的 引用 内 ): 
要 信任 位置 取消 
Pe 机 有 安 , 并) “ 
日 禁用 所 有 去 ,并 发 iID) 洲 师 四 ) 
ee 要 用 无 数字 答 雪 的 折 有 妆 (G) + 
Me 加 启 用 所 有 去 (不 推荐 ; 可 能 会 运行 有 潜在 危 夫 的 代码 ) 优先 级 i 
ActiveX 设置 
| | rot nl 到 
消息 栏 
外 部 内 容 
文件 阻止 设置 s\Microsoft Shar' 
个 人 信息 和 硕 
图 10-3 ”安全 性 选项 对 话 杠 图 10-4 添加 外 部 引用 


添加 该 引用 后 ， 在 代码 中 可 以 声明 以 VBIDE 开头 的 对 象 类 型 。 
10.1.1 引用 的 属性 


VBA 工程 中 的 一 个 引用 其 实 是 建立 了 VBA 工程 与 外 部 动态 链接 库 文件 的 一 种 链接 关 
系 ， 假 设 添加 “ Microsoft Scripting Runtime ”这 个 引用 ,该 引用 的 名 称 是 “ Scripting”"， 描 
述 是 “Microsoft Scripting Runtime”， 完 全 路 径 是 “ C:\Windows\System32\scrrun.dll”"， 如 图 
10-5 所 示 。 


3 用- VeAProiect li i 
可 使 用 的 引用 0 


Visual Basic For Applications 取消 
Microsoft Excel 15.0 Object Library 

OLE Automation - 
[A Microsoft Office 15.0 Object Libran 浏览 四 . 
ierosoft Visul Basic for Applies 全 
DMierosoft 而 

VEAProject 先 级 
DvBAproject 帮助 00 


DYindows Seript Host Object Nodel 
DAccessibilityCplAdnin 1.0 ye Lib 
AccountProtect 1.0 Type 
crabat 


» 
Microsoft Seripting Runtine 卫 escription 一 一 


定位 : C:MWindows\systen32\serrun. dl Ful lPath 
语言 : 慰 


图 10-5 引用 的 描述 和 完全 路 径 
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另外 ， 引 用 的 对 象 库 在 系统 的 注册 表 中 均 有 记录 ， 具体 位 置 如 下 。 


HKEY_CLASSES_ ROOT\TypeLib\ 


例如 ， 展 开 {420B2830-E718-11CF-893D-00A0C9054228} 下 面 的 1.0 注册 表 项 ， 右 侧 窗 
格 可 以 看 到 描述 文本 为 “Microsoft Scripting Runtime”。 其 中 ，{420B2830-E718-11CF-893D- 
00A0C9054228} 就 是 这 个 引用 库 文件 的 GUID。1.0 表示 这 个 动态 链接 库 文件 的 版 本 号 ， 主 
版 本 号 为 1， 次 版 本 号 为 0， 如 图 10-6 所 示 。 


HE i EE 
Ei 

TL 可 车 去 

本 my pre 


» dl BEDcap9a 6AFO .LID4.963C-00003986cH77 
» Bl BFADACA7-1600-11D2 AsE9.00104B36SC98 
» Ml F980457-5518-49cs-BO68 JFDECCDSAFAS| 

Bl Fre9171 1582-L1D1 9605-00600818410c) 

Bl oawTaF gsg44515 .97FE Ba2D0CATIDEDz) 

Bl aozqaoo ClE 11p3 soFC_o0s0oaADlhee| 

| » Mio2391. CaE .llpa .soFC oosooaADlAee| 
» Bl Mao3s1CDAF2-LIDl gf10.00c04FC2C178) 

Dd M126535C 7240 A768- AEC2.9A791745638) 
M1738EEA 442F-477F-92CF-28898D6CD7E7) 
MlA20559-7677-4383-AA12-88CESCFCF2BO) 
MlCSFFFE-3600-415D-9ED0-2976A342A1CD 

DSAB80-J0E9 383E AS 


aol 
M2SIA64L SFA3-11D2 90C2 O000C7E300X4) 
Man97E06 6r13-4D5 A045-SE7ECD2FIEED) 
J eachaoe F26r 4148 20D5 -AST7BAS OI) 
3126E00-DyC CFADBCowAcoAtoo3 
县 (43142315-EC1D-43C2-BDEA-9DASOFBABA4Y) 
» (3563607078-4e9F-AAAE-OATIATA23600) 
> (3760IDF -0480-471-9D4-004n190 BD) 国 
> ypEtP-renlHlpe-a0DAao50DAIcod9 
> oaDAsDLPDLIDG SBAE -Ooo0fa0270F) 
» 县 wo6tDp36282C.435D.a6E5-HAB9086MCE 站 
» 3012283-1E9F 46F-AEIF-ACOIFDIASIED 
» G3E734CA O30-4A70-962C-ABT254063091) 
» taniFCF-M5D-103.9P7C.00500AE G818) 
> Gana0065-4495.4057-A605-710ETCI1D3ON 
C4541A0.F621-a453-966A 52D1589585D) 


ce 


图 10-6 引用 对 象 库 的 GUID 


因此 ，VBA 工程 中 引用 的 常用 属性 如 下 。 

口 Name: 引用 的 名 称 。 

口 Description: 引用 的 描述 。 

口 GUID: 注册 表 中 的 存储 信息 。 

口 Major: 主 版 本 号 。 

口 Minor: 次 版 本 号 。 

口 FullPath: 动态 链接 库 的 路 径 。 

运行 如 下 程序 ， 可 以 打印 VBA 工程 中 每 个 引用 的 属性 。 


Sub 遍历 所 有 引用 () 
Dim ref As VBIDE.Reference 
， Application.ActiveWorkbook.VBProject.References ' 活动 工作 簿 的 所 有 引用 
For Each ref In Application.VBE.ActiveVBProject.References 
Debug.Print ref.Name, ref.Description, ref.GUID, ref.Major, ref.Minor, 
ref.FullPath 
Next ref 
End Sub 


代码 分 析 : Application.ActiveWorkbook.VBProject 表示 Excel 的 活动 工作 簿 的 VBA 工 
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程 ， 而 Application VBE.ActiveVBProject 表示 VBE 中 的 活动 工程 ， 不 是 同一 个 概念 。 
VBA 编程 过 程 中 ,使 用 最 频繁 的 引用 如 表 10-1 所 示 。 


表 10-1 VBA 最 常用 的 外 部 引用 


次 版 
名 称 描 述 GUID a 
号 
: i {00020813-0000-0000-C000- 
Excel Microsoft Excel 15.0 Object Library 8 
000000000046} 
E ; {00020905-0000-0000-C000- 
Word Microsoft Word 15.0 Object Library 6 
000000000046} 
: Microsoft PowerPoint 11.0 Object | {91493440-5A91-11CF-8700- 
PowerPoint 8 
Library 00AA0060263B} 
Gt 放心 Mi ft Outlook 15 0 Object Li {00062FFF-0000-0000-C000- 8 
utlool crosoft Outlook 15.0 Object Library 000000000046} 4 
le : {2DF8D04C-5BFA-101B- 
Off Mi ft Office 15.0 Object Lib 2 7 
es Ye TY | BDES-00AA0044DES2} 
VBIDE Microsoft Visual Basic for Applications | {0002E157-0000-0000-C000- 和 
Extensibility 5.3 000000000046} 
MSForms Microsoft Forms 2.0 Object Librai ODASD EO OA 和 0 
rl YY | 02608C4DOBB4} 


Es E = 
VBScript RegExp_55 een VBScript Regular {3F4DACA7-160D-11D2 5 5 
Expressions 5.5 A8E9-00104B365C9F} 


Scriptint Microsoft Scripting Runtime 人 1 0 
pnB Pe 00A0C9054228} 
F5078F18-C551-11D3-89B9- 
MSXML2 Microsoft XML. v6.0 { 0 
O000F81FE221} 
; F935DC20-1CF0-11D0- 
IWshRuntimeLibrary | Windows Script Host Object Model { 1 0 
ADB9-00C04FD58A0B} 
WinH | 1 
Gi Ye | D9A2570F2B2E} 
3050F1C5-98B5-11CF-BB82- 
MSHTML Microsoft HTML Object Library 4 0 
00AA00OBDCEOB} 
{EAB22AC0-30C1-11CF- 
SHDocVw Microsoft Internet Controls 1 
A7TEB-0000C05BAE0B} 
Microsoft ActiveX Data Objects 2.8 | {2A75196C-D9EB-4129-B803- 
ADODB 浊 8 
Library 931327F72D5C} 
Microsoft ADO Ext. 2.8 for DDL and | {00000600-0000-0010-8000- 
ADOX 2 8 
Security 00AA006D2EA4} 
_ _ {0ES9F1D2-1FBE-11D0-8FF2- 
MSScriptControl Microsoft Script Control 1.0 1 0 
00A0D10038BC} 
S0A7E9B0-70EF-11D1-B7SA- 
Shell32 Microsoft Shell Controls And Automation 1 0 
00A0C90564FE} 
Wibemscripti Mi 全 WMI Seriptine V1 21 {565783C6-CB41-11D1-8B02- i 2 
emScripting croso! cripting V1.2 Library 00600806D9B6} 
CD000000-8B95-11D1-82DB- 
CDO Microsof CDO for Windows 2000 Library { t 0 
00C04FB1625D} 
{E64169B3-3592-47D2-816E- 
Acrobat Adobe Acrobat 9.0 Type Library 1 
602C5C13F328} 
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10.1.2 内置 引用 


任何 一 个 VBA 工程 都 有 一 些 内 置 引 用 ， 例 如 Excel VBA 中 的 内 置 引 用 是 Visual Basic 
for Applications 和 Microsoft Excel x.0 Object Library。 这 些 内 置 引用 的 Builtin 属性 为 True， 
而 且 不 能 移 除 内 置 引用 。 

下 面 的 程序 可 以 批量 移 除 工 作 德 的 VBA 工程 中 的 非 内 置 引用 。 


Sub 移 除 所 有 非 内 置 引用 () LB 
Dim ref As VBIDE.Reference 可 使 用 的 引用 人 A) 
For Each ref In Application.ActiveWorkbook. 
VBProject .References 
If ref.BuiltIn = False Then 
Application.ActiveWorkbook. 
VBProject .References.Remove ref 


End If 
Next ref 
End Sub Merosoft Excel 15.0 Object Library 
a Ee Files\Microsoft Office\DEficelS\EXCEL 1 
运行 上 述 程序 ， 引 用 对 话 框 中 只 有 两 个 内 置 
引用 仍 处 于 勾 选 状态 ， 如 图 10-7 所 示 。 图 10-7 Excel VBA 工程 中 的 两 个 内 置 引用 


10.1.3 引用 的 添加 


使 用 代码 自动 为 VBA 工程 添加 引用 ， 可 以 使 用 AddFromFile 、AddFromGnuid 两 种 方法 。 
AddFromFile 方法 需要 提供 外 部 引用 文件 的 路 径 ，AddFromGnuid 方法 需要 提供 外 部 引用 库 的 
GUID 值 和 版 本 号 。 

例如 ， 下 面 的 程序 分 别 使 用 以 上 两 种 方法 ， 自 动 为 活动 工作 敌 的 VBA 工程 添加 XML 
V6.0、PowerPoint 11.0 的 引用 。 


Sub 引用 的 添加 () 
Dim ref As VBIDE.Reference 
Set ref = Application.ActiveWorkbook.VBProject.References.AddFromFile 
(Filename:="C:\Windows\System32\msxm16.d11") ' 添加 XML v6.0 
Set ref = Application.ActiveWorkbook.VBProject.References.AddFromGuid (GUID: 
="{91493440-5A91-11CF-8700-00AA0060263B}"，Major:=2，Minor:=8) ' 添加 PowerPoint 11.0 
End Sub 


注意 同一 个 引用 不 能 重复 添加 多 次 ， 也 不 能 添加 不 同 版 本 的 同一 引用 。 例 如 ， 不 能 在 
同一 个 工程 同时 添加 Office 11.0 和 Office 15.0。 


10.1.4 引用 的 移 除 


使 用 Remove 方 法 可 以 移 除 工程 中 已 存在 的 引用 ,但 是 移 除 之 前 必须 先知 道 该 引用 的 
名 称 (是 Name， 不 是 Description), 例 如 Microsoft XML V6.0 这 个 引用 的 名 称 是 MSXML2， 
OLE Automation 这 个 引用 的 名 称 是 stdole。 
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下 面 的 程序 移 除 活动 工作 短 的 VBA 工程 中 的 两 个 引用 。 
Sub 引用 的 移 除 () 


Dim ref As VBIDE.Reference 
Set ref = Application.ActiveWorkbook.VBProject.References.Item("MSXML2") 
Application.ActiveWorkbook .VBProject.References.Remove Reference:=ref 

' 移 除 Microsoft XML v6.0 
Set ref = Application.ActiveWorkbook.VBProject.References.Item("stdole") 
Application.ActiveWorkbook.VBProject.References.Remove Reference:=ref 

' 移 除 OLE Automation 


End Sub 


注意 ”内置 引用 不 能 被 移 除 ， 例 如 Word VBA 工程 中 不 能 移 除 Microsoft Word Object Library。 


以 上 程序 的 源 代码 文件 为 “实例 文档 53.xlsm”。 


10.2 ”外 部 对 象 和 注册 表 


Windows 系统 的 注册 表 中 ， 不 仅 存储 着 各 个 外 部 引用 库 的 GUID ， 而 且 引 用 库 中 的 对 象 
和 类 也 都 有 相应 的 CLSID。 

在 注册 表 编 辑 嚣 中， 展开 如 下 注册 表 项 。 

HKEY_CLASSES_ROOT\CLSID 

可 以 看 到 下 面包 含 了 很 多 用 花 括 号 括 起 来 的 子 项 。 

例如 展开 {3F4DACA4-160D-11D2-A8E9-00104B365C9F} 这 个 子 项 ， 可 以 看 到 ProgID 
的 值 为 VBScriptRegExp， 如 图 10-8 所 示 。 


Bn 和 和 机 而 两 本 页 em | 


文人 四， 焕 和 二 看 M， 收 站 大 A) 才 N(H) 
-下 GBFIB1773-65CB-4D89.0FCE-ACED47DBISSA| “| 安 队 FP i 
» B (F281000 -E95A-11d2-8868 00CD4F369FD4) Eww REG 52 VBScript RegExp ] 
-四 (3F30CS69-480A-4C6C-362D-EFCO8S788345) 

(3F35cs00-4394-L1D2-8FEC.00CO4FA3000) 
?省 (3F35C303.4394-L1D2-8FEC-00C04FA30000) | 
B GF35F070-99D6-1102-8D10-00A0Coaa1 E20 
> (F4360DC E677 ALA8-8EFA SFa9AA6D2C8) 
» Bh Bf454oe 42ae 4d7c-Bee3.328250d5e2721 
有 (F44283-6A08-3ES0-AS76-2C2D38E4E808) 
1 GRIDACAI60D-TID2-ASE9.00104836SC9F 
县 mprocservera2 


Wl OLESeript 


| ProgID 
Typetib 
县 version 
563899-BA65478Z-BA90-966357CEE7F 
入 (F5053F0-5350-47FC-EDg9.qF2CP9sA62FD} 
外遇 BF69F351.0379.11D2.A484 00CO4FaEFB59) 
有 (F685E16-092A-41ED-9308-0B4125D91D4E} 
5 f6bc534-dfal-4ab4-ae54-ef25a74e0107) 
» -3F98D457-5518-43C5-8DES-JFDECCDSAFAS) 


{BFATA1CS-812C-3856-R957-CB14AF670C06} 
上 - 坟 aFAAoaF3-79FB-4319.8387-BaFFEO74FaDA) 。 ~ 


， 到 ; 


NHKEY_CLASSES_ROOT\CLSID\M3F4DACA4-160D-11D2-A8E9-00104B355C9F]\ProgID | 
图 10-8 ”正则 表达 式 对 象 库 的 CLSID 和 ProgID 
因此 可 以 看 出 ， 正 则 表达 式 对 象 的 ProgID 是 VBScript.RegExp, CLSID 是 {3F4DACA4- 


160D-11D2-A8E9-00104B365C9F}。 
其 他 常见 对 象 的 CLSID 、ProgID 也 可 以 从 注册 表 中 找到 。 
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10.2.1 CLSID 和 ProglD 


CLSID 是 指 Windows 系统 对 于 不 同 的 应 用 程序 、 文 件 类 型 、OLE 对 象 、 特 殊 文 件 夹 以 
及 各 种 系统 组 件 分 配 的 一 个 唯一 表示 它 的 ID 代码 ， 用 于 对 其 身份 的 标识 和 与 其 他 对 象 进行 
区 分 。 

ProgID 是 程序 员 给 某 个 CLSID 指定 的 一 个 易 记 的 名 字 。 

VBA 编程 常用 对 象 的 CLSID 、ProgID 如 表 10-2 所 示 。 


表 10-2 VBA 常用 对 象 的 CLSID、ProgID 


可 有 ET 


Excel Microsoft Excel 15.0 Ne a {00024500-0000-0000-C000- 
2 . Excel.Application Excel.Application.15 

应 用 程序 Object Library 000000000046} 

Word Microsoft Word 15.0 i ee ea {000209FF-0000- 

应 用 程序 ”|Object Library PP -+p ”| oooo-cooo-oo0000000046} 


Powerpoint | Microsoft PowerPoint A Powerp: {91493441-5A91-11CF-8700- 
应 用 程序 “| 15.0 Object Library 0 Application.15 00AA0060263B} 
Outlook ee Outlook 15. Cs Outloo) {0006F03A-0000- 
6 本 Outlook.Application 
应 用 程序 ct 工 n.15 0000-C000-000000000046} 


{3F4DACA4-160D-11D2- 
A8E9-00104B365C9F} 


{EE09B103-97E0-11CF- 
978F-00A02463E06F} 


FSO Microsoft Scripting criptins criptin {0D43FE01-F093-11CF- 
Runtime ileSystemObject ileSystemObject 8940-00A0C9054228} 

MSXML2. Msxml2. 88d96a05-f192-11d4-a65f- 

XML 文 档 |Microsoft XML. v6.0 ee 1 a 
DOMDocument60 DOMDocume 0 |0040963251e5} 

XMLHTTP |Microsoft XML v60 MSXI {88d96a0a-f192-11d4-a65f- 

3 0040963251e5} 
wshShell dows Script Host 
De Model 


[WshRuntimeLibrary. WScript Shell {72C24DD5-D70A-438B- 
WshShell Pr 8A42-98424B88AFB8} 
WinH Microsoft WinHTTP {2087c2f4-2cef-4953-a8ab- 
. Services, Version 5 ed ee a 66779b670495} 


.,y, | Microsoft HTML MSHTIML. {25336920-03F9-11cf-8FD0- 
HTML 文 档 htmlfile 
Object Library HIMLDocument 00AA00686F13} 
正 Microsoft Internet SHDocVw. InternetExplorer. {0002DF01-0000- 
Controls InternetExplorer Application 0000-C000-000000000046} 
ADODB. Microsoft ActiveX Data 和 {00000514-0000-0010- 
. ADODB.Connection ADODB.Connection 
Connection | Objects 2.8 Library 8000-00AA006D2EA4} 
ADODB. Microsoft ActiveX Data {00000535-0000-0010- 
, ADODB .Recordset ADODB.Recordset 
Recordset Objects 2.8 Library 8000-00AA006D2EA4} 
MSScript Microsoft Script MSScriptControl. MSScriptControl. {0E59F1D5-1FBE-11D0- 
Control Control 1.0 ScriptControl ScriptControl 8FF2-00A0D10038BC} 


Microsoft Shell Controls 更 {13709620-C279-11CE- 
Shell32 Shell32.Shell Shell.Application 
And Automation A49E-444553540000} 
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续 表 


对 和 象 引 用 前 期 绑 定 ProgIlD CLSID 
Wbem Microsoft WMI WbemScripting. WbemScripting. {76A64158-CB41-11D1- 
Scripting Scripting V1.2 Library | SWbemLocator SWbemLocator 8B02-00600806D9B6} 

Microsoft CDO for {CD000002-8B95-11D1- 
CDO 配置 CDO.Configuration CDO.Configuration 


Windows 2000 Library 


Microsoft CDO for 
CDO.Message CDO.Message 
Windows 2000 Library 


10.2.2 ”创建 新 对 象 


82DB-00C04FB1625D} 


{CD000001-8B95-11D1- 
82DB-00C04FB1625D} 


CDO 邮件 


前 期 绑 定 (事先 添加 引用 ) 的 方式 ,使 用 New 关键 字 创 建新 对 象 。 

后 期 绑 定 的 方式 ， 只 能 使 用 CreateObject 创建 新 对 象 。 使 用 CreateObject 创建 新 对 象 
时 ， 既 可 以 用 ProgID， 也 可 以 用 CLSID 作为 参数 。 

例如 ， 下 面 的 程序 分 别 使 用 前 期 绑 定 、ProgID 和 CLSID 创建 新 的 XMLHTTP 对 象 。 


Sub 创建 新 对 象 的 方式 () 
Dim A Rs Object，B As Object，C Rs Object 


Set A = New MSXML2 .XMLHTTP60 ' 前 期 绑 定 
Set B = CreateObject ("Msxml2.XMLHTTP.6.0") " 根据 ProgID 
Set C = CreateObject("new:{88d96a0a-f192-11d4-a65f-0040963251e5}") ' 根据 CLSID 


Debug.Print TypeName (A), TypeOf A Is MSXML2 .XMLHTTP60 

Debug.Print TypeName (B), TypeOf B Is MSXML2 .XMLHTTP60 

Debug.Print TypeName (C), TypeOf C Is MSXML2 .XMLHTTP60 
End Sub 


代码 分 析 : 前 期 绑 定 的 类 型 名 、 后 期 绑 定 的 ProgID 、CLSID 的 取 值 来 自 于 表 10-2。 

TypeName 返回 类 型 名 称 ， 是 一 个 字符 串 。TypeOf 用 于 把 一 个 变量 与 类 型 名 称 做 比较 ， 
如 果 类 型 匹配 则 返回 True。 

运行 上 述 程序 ， 立 即 窗口 分 别 打印 对 象 变量 A、B、C 的 类 型 信息 ， 如 图 10-9 所 示 。 


IServerXMLHTTPRequest2 True 
IServerXMLHTTPRequest2 True 
IServerXMLHTTPRequest2 True 


图 10-9 返回 相同 的 对 象 类 型 
可 以 看 出 ，3 个 变量 的 类 型 完全 一 样 ， 都 是 XMLHTTP 对 象 。 


10.2.3 ”VBA 中 使 用 蔓 


在 实际 编程 过 程 中 ， 经 常 需要 剪贴 板 的 自动 化 操作 ， 例 如 把 字符 串 放 到 剪贴 板 上 ， 或 者 
从 剪贴 板 上 获取 数据 。 
下 面 的 程序 使 用 后 期 绑 定 方式 ， 把 一 个 英文 句子 放 入 剪贴 板 。 


侧 。 office VBA 开发 经 典 -一 中 级 进 阶 郑 


Sub 放 入 剪贴 板 () 
Dim D As Object 
Set D = CreateObject ("new: {1C3B4210-F441-11CE-B9EA-00AAO006B1A69}") 
With D 
"Clear 
.SetText "Have a good dream" 
-PutInClipboard 
End With 
End sub 


运行 上 述 程序 后 ， 在 任意 可 以 输入 文字 的 地 方 按 下 【 CalrV 】 快捷 键 就 可 以 粘贴 如 上 内 容 。 
反 过 来 ， 如 果 从 现在 的 剪贴 板 上 获取 文字 内 容 ， 可 以 运行 如 下 程序 。 
Sub 获取 剪贴 板 () 


Dim D As Object 
Set D = CreateObject ("new:{1C3B4210-F441-11CE-B9ERA-00RAR0O06B1R69}") 


With D 
.GetFromClipboard 
Debug.Print .GetText 
End With 
End Sub 


如 果 采 用 前 期 绑 定 的 方式 ， 需 要 事先 添加 “ Microsoft Forms 2.0 Object Library” 外 部 
引用 。 


Sub 剪贴 板 _ 前 期 绑 定 () 
Dim D As MSForms.DataObject 
Dim strl As String, str2 As String 
strl = "Have a good dream" 
Set D = New MSForms.DataObject 
With D 
“Clear 
.SetText strl 
.PutInClipboard 
.GetFromClipboard 
str2 = .GetText 
Debug.Print str2 
End With 
End Sub 


代码 分 析 : 首先 把 strl 的 内 容 放 到 剪贴 板 ， 然 后 从 剪贴 板 获取 数据 并 赋 给 str2。 
运行 上 述 程序 , 立即 窗口 的 打印 结果 仍然 是 “Have a good dream”。 
以 上 程序 的 源 代码 文件 为 “实例 文档 54.xlsm”。 


10.3 “本章 小 结 


VBIDE 中 的 References 集合 表示 的 是 引用 对 话 框 中 处 于 色 选 的 那些 引用 。 一 个 引用 的 
主要 属性 有 Name、Description 、GUID 、FullPath 等 。 

外 部 对 象 的 CLSID 和 ProgID 的 对 应 关系 可 以 从 注册 表 中 看 到 。 使 用 CreateObject 创建 
新 对 象 ， 一 般 使 用 ProgID 作为 参数 。 
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操作 Acrobat 对 象 


在 日 常 办 公 中 ，PDF 文件 的 使 用 频率 非常 高 ， 而 且 Office 文档 可 以 方便 地 转换 为 PDF 
文件 ， 如 何 快速 、 准 确 地 对 PDF 文件 进行 自动 化 处 理 ， 也 是 程序 设计 中 的 迫切 之 需 。 
Adobe Acrobat 是 由 Adobe 公司 开发 的 一 款 PDF ( (Portable Document Format， 便 携 式 文 
档 格式 ) 编辑 软件 ， 借 助 Acrobat 可 以 对 PDF 文档 进行 浏览 、 打 印 和 编辑 ， 或 使 用 更 高 级 的 
功能 。 当 计算 机 中 安装 了 Adobe Acrobat 之 后 ， 系 统 中 会 出 现 一 个 Adobe Acrobat X.0 Type 
Library 的 对 象 库 ， 该 对 象 库 也 可 以 被 引用 到 VBA 工程 中 ， 从 而 实现 用 VBA 对 Acrobat 软 
件 及 其 打开 的 PDF 文档 进行 操作 。 
本 章 的 主要 内 容 包 括 Offce 文档 自动 导出 为 PDF 文件 ， 以 及 使 用 VBA 操作 Acrobat 对 
象 ， 达 到 用 VBA 自动 使 用 Acrobat 软件 中 的 命令 的 目的 。 
本 章 用 到 的 外 部 引用 和 重要 对 象 : 
口 Adobe Acrobat 9.0 Type Library 
> Acrobat.AcroApp 
Acrobat.AcroAVDoc 
Acrobat.AcroAVPageView 
> Acrobat.AcroPDDoc 


11.1 认识 Adobe Acrobat 


PDF 文件 的 浏览 、 编 辑 软件 非常 多 ， 但 是 Acrobat 软件 是 最 专业 的 一 款 PDF 软件 。 
Acrobat 软件 包括 主 菜单 、 工 具 栏 、 导 航 窗 格 、 右 键 菜单 等 界面 元 素 ， 如 图 11-1 所 示 。 

其 中 ， 主 菜单 中 的 【视图 】 菜单 用 于 设置 PDF 的 阅读 模式 、 缩 放 比 例 等 。[ 文档 ] 菜单 
中 的 命令 用 于 文档 编辑 ， 例 如 增加 和 删除 页 面 操作 等 。 关 于 其 他 菜单 ， 包 括 工具 栏 的 功能 ， 
此 处 不 一 一 讲解 。 
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>>> math cos(1.2) 
0.36235775447667362 
但 若 要 使 用 向 量 和 矩阵 计算 功能 ， 则 需要 导入 更 强大 的 numpy 包 - 
>>> mportnumpy 
>>> anumpyarray([12.3,#5.6]) 。 # 亨 建 一 个 向 县 或 数组 
>>> printa 
[123456] 


# 碑 取向 量 在 各 维 上 的 长 度 


如 果 要 使 用 快速 Fourier 变换 ， 则 需要 导入 mumpy 包 中 的 航模 块 . 
>>> impart numpy 组 xn 组 。。”# 导 入 级 模块 并 重 命名 为 入 
-123 和 
>>> 9a) # 使 用 级 模块 中 的 级 画 数 ， 用 于 执行 向 量 a 的 Fourier 变换 
amay([ 10.+0j, -2.+2j, -2.+0j, 22D 


Python 中 的 任何 事物 都 是 对 象 ， 比 如 一 个 整 型 数 、 一 个 美 定义 、 一 个 字符 串 等 全 部 都 
是 对 象 ， 这 意味 着 可 以 调用 这 些 对 象 的 方法 。 例 如 任何 字符 串 都 可 以 通过 split0 函 数 来 分 割 
字符 串 。Python 中 创建 类 对 象 可 以 通过 “构造 函数 ”来 创建 ， 而 这 种 “构造 函数 ”看 上 去 
与 普通 函数 充 全 相同 , 比如 使 用 oat0 函 数 就 能 创建 一 个 浮 点 数 对 象 ， 使 用 fle0 函 数 就 能 创 


图 11-1 Adobe Acrobat 软件 
由 于 工具 栏 的 数目 非常 多 ,通常 情况 下 在 屏幕 上 只 显示 一 部 分 工具 栏 ， 如 果 要 显示 或 隐 
藏 更 多 的 工具 栏 ， 可 以 单 击 菜单 【工具 / 自 定义 工具 栏 ]， 弹 出 “更 多 工具 ”对 话 框 ， 如 图 
11-2 所 示 。 


图 11-2 显示 更 多 工具 栏 


Acrobat 软件 在 使 用 方式 上 比较 类 似 于 Microsoft Word， 可 以 同时 打开 计算 机 中 多 个 
PDF 文件 ， 同 时 该 软件 的 大 量 常用 快捷 键 也 和 Word 中 的 几乎 一 样 。 
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1.2 Office 文档 导出 为 PDF 文件 
PDF 文件 的 生成 和 创建 有 非常 多 的 方法 ,例如 用 LaTeX、OpenOffice、 微 软 Office 都 可 
以 生成 PDF 文件 。 


Office 2013 中 的 Excel、PowerPoint、Word 文档 均 可 导出 为 PDF 文件 ， 如 果 手 工 导出 ， 
需要 在 backstage 视图 中 依次 单 击 【导出 /创建 PDF 】)， 如 图 11-3 所 示 。 


Office VBA 开 发 经 典 -中 级 进出 卷 docm 


创建 PDF/XPS 文档 
加 全 于 ”保管 布局 、 梧 式 、 字 体 和 区 像 
和 内容 不 能 轻 虹 更 改 
[= 更 改 文件 类 型 日 Web 上 近代 了 免费 喜 看 器 


后 


Pa 


创建 PDF/XPS 


图 11-3 Word 文档 导出 为 PDF 文件 


接 下 来 会 弹出 一 个 路 径 选 择 的 对 话 框 ,一 定 要 注意 对 话 框 右 下 角 有 个 “选项 ”按钮 ， 如 
图 11-4 所 示 。 


“选项 ”对 话 框 中 主要 包括 导出 范围 ， 是 全 文档 导出 ， 还 是 所 选 内 容 导出 ， 如 图 11-5 所 示 。 


[ 工 ，1 要 . 
《 区 本 卡 ， 计 得 WL， 作 品 (E) ，Offce VBA ， | 她 肌 寺村 Office_ P| 
加 = 
ee E 到 项 [PE 
2 罗 IE 
二 汪 乐 
temp.pdf EE 
由 Fiddler 调 试 权威 指南 + ( 美 ) 靶 伦 斯 等.PDF 全 当前 页 (6) 
网 PE 组 加 第 14 章 自 定义 Excel 2007 的 用 户 界面 pdf ps 
岂 第 9 章 Excel VBA 对 铺 模 型 和 应 用 程序 对 象 一 - = 
© mG) MN: 1 Ey 
几 “ 酝 计算 机 上 RegExp 
后 驱动 A) 下 BofficeidMsoViewer 发 布 内 容 | 
和 岛 系统 (CC) B GetEnums @ 文 桔 (D) 
| ED et 显示 了 标的 文档 (O) || 
回 全 加 -ps 包括 打印 信息 | 
BE FvceirOMAaddin 
名 软件 中 ~ Ph 可 辐 创建 书 答 时 使 用 (: 
文件 名 (N): temp.pdf 加 标量 
D Word 书 笃 四 
保存 类 型 (T): PDI 
mm EPEEed 回 文 检 必 性 区) 
优化 回 人 | | 
| 蝇 晤 小 文件 大 小 飞机 发 回答 全 1SO 19005-1 标 全 PDF/AD 
向 (M) 回 无 二 斌 入 闻 体 情 郊 下 显示 文本 位 园 00 
回 使 用 放 码 加 灾 文档 IN) 
| 
3 axa za ~ 一 到 ED EE 
一 一 一 一 让 


图 11-4 导出 选项 图 11-5 “选项 ”对 话 框 
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把 以 上 各 项 进行 恰当 设置 后 ， 就 可 以 在 路 径 下 生成 想 要 的 PDF 文件 。 


11.2.1 ”Word 文档 导出 为 PDF 文件 


在 Word VBA 中 ，Document 对 象 或 Selection 对 象 下 面 的 ExportAsFixedFormat 方法 就 
是 用 来 导出 文档 的 。 

编写 并 运行 下 面 的 过 程 ， 即 可 把 活动 Word 文档 生成 为 PDF 文件 。 

Sub 导出 文档 的 全 部 () 


Application.ActiveDocument .ExportAsFixedFormat OutputFileName:="E:\Office 
VBA\temp.pdf", _ 

ExportFormat :=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _ 

wdExportOptimizeForPrint, Item:= _ 

wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ 

CreateBookmarks:=wdExportCreateHeadingBookmarks, DocSstructureTags:=True, _ 

BitmapMissingFonts:=True, UseIS0O19005 1:=False 

End Sub 


ExportAsFixedFormat 方法 的 各 个 参数 说 明 如 下 。 

OutputFileName:="E:\Office VBA\temp.pdf" 表示 导出 文件 的 目标 名 称 和 路 径 。 

ExportFormat:=wdExportFormatPDF 表示 导出 的 格式 是 PDF 文件 。 

OpenAfterExport:=True 表示 导出 操作 完成 后 自动 打开 PDF 文件 。 

OptimizeFor:=wdExportOptimizeForPrint 表示 “优化 (标准 联机 发 布 和 打印 六。 

Item:=wdExportDocumentContent 表示 导出 文档 所 有 内 容 。 

IncludeDocProps:=True 表示 勾 选 “文档 属性 ”。 

KeepIRM:=True 未 知 。 

CreateBookmarks:=wdExportCreateHeadingBookmarks 表示 勾 选 “创建 书签 时 使 用 标题 " 。 

DocStructureTags:=True 表示 勾 选 “辅助 功能 文档 结构 标记 ”。 

BitmapMissingFonts:=True 表示 勾 选 “无 法 能 入 字体 情况 下 使 用 文本 位 图 ”。 

UseISO19005_1:=False 表示 不 勾 选 “符合 ISO19005-1 标准 ”。 

如 果 要 导出 Word 文档 中 鼠标 选中 的 内 容 ， 只 需要 把 上 述 代码 中 的 ActiveDocument 换 
成 Selection 即 可 。 


Sub 导出 所 选 内 容 () 

Application.Selection.ExportAsFixedFormat OutputFileName:="E:\Office_VBA\ 
temp.pdf", _ 

ExportFormat :=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= 
WwdExportOptimizeForPrint, ExportCurrentPage:=False, Item:= _ 
wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ 
CreateBookmarks:=wdExportCreateHeadingBookmarks, DocstructureTags:=True, _ 
BitmapMissingFonts:=True，UseISO19005 1:=False 

End Sub 


11.2.2 “Excel 工作 短 导 出 为 PDF 文件 
Excel 导出 为 PDF 的 选项 对 话 框 ， 内 容 略 有 不 同 ， 如 图 11-6 所 示 。 
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Excel VBA 中 的 Workbook、Worksheet、Range 对 象 之 ”下 esi 
后 都 有 ExportAsFixedFormat 方法 ， 分 别 表示 把 整个 工作 短 、 | zw 
工作 表 、 单 元 格 导出 为 PDF 文件 。 or Mm 司 sm 一 本 
发 内 容 
全 lent: 。 6 性 TI 二 加 
ActiveWorkbook. ExportAsFixedFormat … 表 示 把 活动 工 全 
作 短 导出 为 PDF。 包括 4HJ 印 信息 
团 文才 
Worksheets(2). ExportAsFixedFormat … 表 示 把 第 二 个 工 a 
| PDF 选项 
作 表 导出 为 PDF。 回 符合 150 19005-1 标 且 (PDF/A}(D 
Application.ActiveSheet ExportAsFixedFormat … 表 示 把 
活动 工作 表 导 出 为 PDF。 
_ 图 11-6 ”Excel 工作 短 导 出 为 
Application.Selection. ExportAsFixedFormat … 表 示 把 鼠 


PDF 的 选项 对 话 框 
标 所 选单 元 格 区 域 导出 为 PDF。 


下 面 的 代码 把 Excel 所 选区 域 导出 为 PDF 文件 。 


Sub Excel 导出 为 PDF () 
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
"E:\temp.pdf", Quality:= _ 
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _ 
OpenAfterPublish:=True 


End Sub 
二 二 EE a E>)| 
11.2.3 ”PowerPoint 演示 文稿 导出 为 PDF 文件 硒 
加 宕 向 站 当前 幻灯 片 加 “所 三 内 号 5) 
定义 放风 (OX 口 
PowerPoint 导出 PDF 的 选项 对 话 框 如 图 11-7 所 示 。 Ca ee 上 
发 这 
下 面 的 过 程 把 活动 演示 文稿 导出 为 PDF 文件 。 0 后 
oo 重水 Fn | 回国 
Sub 演示 文稿 导出 为 PDF () Drm sa 
Application.ActivePresentation.ExportAsFixed Format | 所 
Path:="C:\temp\temp.pdf", FixedFormatType:=PowerPoint. 回放) 
PpFixedFormatType.ppFixedFormatTypePDF i 
End Sub | 问 特 全 150 19005-1 PDF/AD) 
园 无 # 撒 入 字 妇 | 显示 文本 位 轴 00 
关于 ExportAsFixedFormat 方法 更 多 的 参数 说 明 ， 请 参 CE 
阅 微 软 提 供 的 MSDN 在 线 帮 助 。 图 11-7 PowerPoint 文件 导出 


为 PDF 的 选项 对 话 框 


11.3 ”Acrobat 对 象 模型 
计算 机 中 安装 了 Adobe Acrobat 软件 后 ， 可 以 用 VBA 访问 Acrobat 软件 以 及 PDF 文档 。 
11.3.1 引用 Acrobat 对 象 库 


VBA 中 访问 Acrobat 对 象 ， 需 要 事先 为 VBA 工 程 添加 “Adobe Acrobat X.0 Type 
Library” 引 用 ， 如 图 11-8 所 示 。 
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3 Vee 
可 使 用 的 引用 0); 


可 Visaal Basic For Applications ~ 取消 
Sorosot Excel 15.0 Object Librar 
MOLE hntomation 


Scan 1.0 Type Library 
TebCapture 1.0 Type Librar 。 
hf entmre Th Tanlher/Pewm 


E 

Adobe Acrobat 9.0 Type Library 
定位 :C:\Programn Files\Adobe\Aerobat 9.0\Acrobat\acrobat 
语言 。 标准 


图 11-8 添加 外 部 引用 
当 在 VBA 工程 中 引用 了 Acrobat， 按 下 F2 键 后 在 对 象 浏览 器 中 可 以 看 到 Acrobat 的 对 
象 模型 ， 如 图 11-9 所 示 。 


殉 AerohXDoc = Application 


SY GetActiveDoc 
= GetActiveTool 
= GetAyDoc 


区 McroAVPageView 
区 | AcroAXDoe 

区 AcroHiliteList 
网 AcroPDAnnot 
AcroPDBookmark 
有 AeroPDDoc 

哆 AeroFDPage 

网 AcroPDTextSelect 
网 AcroPoint 

网 AcroRect 

区 AeroTime 

(aP MVOpenParans 


= Hide 
:8 Lock 

= Naximize 

= NenultemExecute 
= NenultenIsEnabled 
= NenultenIslarked 
= NenultenRenove 
= Mininize 

= Restore 

= SethctiveTool 
= SetFrame 

= SetPreferenceEx 


(epP PDRotateFlags 
(aP PISaveFlags 
IeP PhViewode 


Class AcroApp 


Acrobat 的 成 员 


图 11-9 Acrobat 对 象 库 的 主要 成 员 


11.3.2 ” Acrobat 常用 对 象 


利用 VBA 操 作 Acrobat 软 件 以 及 在 Acrobat 软件 中 打开 的 PDF 文档 需要 了 解 
AcroApp 、AcroAVDoc、AcroPageView 对 象 ， 如 果 要 直接 操作 计算 机 中 的 PDF 文件， 可 以 
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使 用 AcroPDDoc 对 象 后 台 方式 打开 文档 ， 无 论 哪 一 种 方式 ， 都 可 以 用 AcroPDPage 对 象 来 
操作 PDF 文档 的 页 面 。 
Acrobat 常用 的 对 象 模型 如 图 11-10 所 示 。 


AcroApp 应 用 程序 对 象 


| AcroAVDoc 文 档 对 象 ”| 一 | AcroPDDoc 后 台 文档 


AcroAVPageView 视 图 对 象 
AcroPDPage 页 面 对 象 


图 11-10 ”Acrobat 常用 对 象 模型 
如 果 图 11-10 中 的 箭头 是 双向 箭头 ， 表 示 对 象 之 间 可 以 互相 获得 。 


11.3.3 Acrobat 枚 举 常量 


当 VBA 工程 中 引入 了 Acrobat 对象 库 ， 除 了 可 以 声明 相关 的 对 象 类 型 ， 还 会 用 到 对 象 


库 中 的 内 置 枚 举 常 量 ， 这 些 常量 都 以 Acrobat 开头 。 
例如 下 面 的 语句 是 把 Acrobat 中 的 当前 PDF 文档 页 面 缩 放 为 “适合 页 面 宽 度 ”。 


App.GetActiveDoc.GetAVPageView.ZoomTo Acrobat .AVZoomTYpe.RAVZoomFitWidth,100 
运行 上 述 代码 ， 会 自动 勾 选 Acrobat 中 的 菜单 项 【 视图 / 缩放 / 适合 宽度 ]， 如 图 11-11 
所 示 。 


[=pdr -Adobe Acrobat pro > D” wm He es 口 | 日 入 53 
文件 ”篇 加 日 有 文 全 DO 注 志 (CO 表单 RR 工具 (T】 高 级) 窗 口 W) 者 助 (H) 


公有 "he. 加 aa- 


Csy 


七 国 分 争 ， 并 入 于 秦 - 及 泰 灭 之 后 ， 楚 、 汉 
- 统 天 下 ， 后 来 光武 中 兴 ， 传 至 献帝 ， 送 分 
这 禁 可 善 类 ， 迷 信 宦 官 。 及 柏 帝 户 ， 灵 帝 即 
宇 记 章节 等 弄 权 ， 实 武 、 陈 著 谋 诛 之 ， 机 事 不 


图 11-11 使 用 VBA 自动 更 改 缩放 比例 


812 Office VBA 开发 经 典 一 一 中 级 进 阶 卷 


11.4 AcroApp 应 用 程序 对 象 


Acrobat 的 AcroApp 对 象 类 似 于 Excel VBA 中 的 Application 对 象 ， 表 示 一 个 打开 的 


Acrobat 应 用 程序 。AcroApp 对 象 有 大 量 属性 和 方法 ， 如 表 11-1 所 示 。 
表 11-1 AcroApp 对 象 的 常用 属性 和 方法 

属性 或 方法 名 称 功 能 
CloseAllDocs 关闭 所 有 打开 的 PDF 文档 
GetActiveDoc 返回 活动 PDF 文档 对 象 
GetActiveTool 返回 正在 使 用 的 “工具 ” 
GetAVDoc(i) 返回 打开 的 第 i 个 PDF 文档 
GetFrame 返回 应 用 程序 窗口 所 在 的 矩形 ，Rect 对 象 
GetNumAVDocs 返回 打开 的 PDF 文档 总 数 
Hide 隐藏 Acrobat 软件 
MenultemExecute 自动 执行 工具 栏 控件 命令 


SetActiveTool 


SetFrame 


自动 设置 活动 “工具 ” 
重新 规定 应 用 程序 窗口 的 位 置 


一 一 一 一 一 一 


Show 


显示 Acrobat 软件 


11.4.1 创建 Acrobat 对 象 


下 面 的 过 程 打开 Acrobat 软件 ， 显 示 /隐藏 Acrobat 窗口 。 由 于 Exit 方法 不 好 用 
使 用 Shell 调用 任务 管理 器 ， 结 束 Acrobat 进 


Public App As 
Sub Testl1() 
Set APP = 
With App 
.Show 
.Hide 
Shell 
End With 
End Sub 


Acrobat .AcroApp 


CreateObject ("AcroExch.App") 


"taskkill /f /im acrobat.exe", vbHide 


11.4.2 ”获取 已 经 打开 的 Acrobat 对 象 


下 面 的 过 程 通过 GetObject 获取 屏幕 上 已 经 打开 的 Acrobat 软件 ， 如 果 事 先 用 该 软件 已 


经 打开 了 一 些 PDF 文档 ， 运 行 下 面 的 过 程 将 弹出 打开 的 文档 数目 。 


Sub Test2() 


Set App = GetObject("", "AcroExch.App") 


With App 


MsgBox " 打开 的 文档 数目 : " & .GetNumAVDocs 


End With 
End Sub 


井 程 的 方式 退出 Acrobat 软件 


， 因 此 
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11.4.3 ”获取 和 设置 活动 工具 


在 浏览 PDF 文档 的 时 候 ， 鼠 标的 默认 指针 是 一 个 左上 方向 的 箭头 ， 如 果 单 击 工 具 栏 或 
菜单 中 的 “ 手 形 工具 ”， 鼠 标 光 标 会 变 为 手 的 样子 ， 如 图 11-12 所 示 。 


ET Te a 
文人 站 福井 视 VI 双生 (D) 入 际 C] 订单 则 ”工具 (1) RA| 宣 吕 (W] 培 R(H] 


Ee r EE 


口 癌 站 局 人鱼 由 琴 大 


oc bom] 


园 豪杰 三 结义 


图 11-12 Acrobat 中 的 工具 栏 


这 就 涉及 活动 工具 的 状态 获取 和 设置 。 
AcroApp 对 象 的 GetActiveTool 方 法 根据 Acrobat 软件 目前 的 状态 返回 一 个 用 字符 串 表 
达 的 当前 活动 工具 。 常 用 的 活动 工具 名 称 如 下 。 


口 Hand 

口 Note 

口 Select 

口 SelectGraphics 
口 Zoom 

DLink 

口 Thread 


下 面 的 代码 打印 当前 活动 工具 的 名 称 ， 并 且 自 动 设置 活动 工具 为 “ 手 形 ”。 


Sub 活动 工具 的 获取 和 设置 () 


Set App = GetObject("", "AcroExch.App") 


With App 


Debug.Print " 当前 活动 工具 是 : "， .GetActiveTool 
.SetActiveTool "Hand", True 


End With 
End Sub 


11.4.4 ”自动 执行 Acrobat 工具 栏 控件 命令 


AcroApp 对 象 的 MenuItemExecute 方法 可 以 自动 执行 Acrobat 中 的 一 个 工具 栏 命令 ， 下 
面 的 代码 自动 设置 为 “适合 页 面 "， 并 且 跳 转 到 最 后 一 页 。 


Sub 执行 工具 栏 命令 () 


Set App = GetObject("", "AcroExch.App") 


With App 


.MenuItemExecute "FitPage" 
.MenuItemExecute "LastPage" 
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End With 
End Sub 


代码 分 析 : MenuItemExecute "LastPage" 相当 于 单 击 了 Acrobat 菜单 项 中 的 【视图 / 跳 至 
/最 后 一 页 ]， 如 图 11-13 所 示 。 


水 ， 浪 花 淘 尽 英雄 。 是 非 成 败 转 头 空 。 
几 度 夕阳 红 。 
TESTEE 阔 上 ， 民 看 秋月 春风 。 一 壶 浊 酒 喜 相 逢 。 
古今 多 少 事 ， 都 付 笑谈 中 。 


一 一 调 寄 《 临 江 仙 》 
图 11-13 ” 跳 转 到 最 后 一 页 
Acrobat 对 象 中 常用 工具 栏 控件 的 名 称 常量 如 表 11-2 所 示 。 
表 11-2 Acrobat 对 象 中 常用 工具 栏 控件 的 名 称 常量 


常量 功 能 | 第 量 | 功 能 
Hand 手 形 工具 第 一 页 

Zoomm 缩小 上 -页 
ZoomOut 扩大 下 一 页 

Select 选择 最 后 一 页 
GoBack 返回 上 一 视图 显示 /隐藏 工具 栏 
GoForward 跳 转 下 一 视图 显示 /隐藏 菜 单 栏 
Zoom100 显示 整 页 窗口 / 层 乔 


FitPage 适合 页 面 TileHorizontal 水 平平 铺 
FitVisible 适合 可 见 TileVertical 垂直 平 铺 


11.5 AcroAVDOC 文档 对 象 


AcroApp 对 象 的 GetNumAVDocs 属 性 返回 打开 的 文档 数目 ，GetAVDoc(i) 用 来 获取 
第 i 个 PDF 文档 ， 当 i 是 0 时 表示 第 一 个 PDF 文档 ， 返 回 一 个 AcroAVDoc 对 象 。 特 别 地 ， 
AcroApp 的 GetActiveDoc 直接 获取 到 当前 活动 PDF 文档 。 


11.5.1 ”遍历 所 有 打开 的 PDF 文档 


下 面 的 代码 遍历 当前 打开 的 所 有 PDF 文档 ， 然 后 打印 每 个 文档 的 标题 。 
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Sub 遍历 打开 的 PDF 文件 () 
Dim App As Acrobat.AcroApp 
Dim Doc Rs Acrobat.AcroAVDoc 
Dim i As Integer 
Set App = GetObject("", "AcroExch.App") 
For i = 0 To App.GetNumAVDocs -1 
Set Doc = App.GetAVDoc (i) 
With Doc 
.BringToFront 
Debug.Print "标题 : "， .GetTitle 
End With 
Next i 
End Sub 


代码 中 的 BringToFront 表示 把 一 个 文档 前 置 ， 成 为 活动 文档 。 
运行 上 述 过 程 ， 立 即 窗口 的 打印 结果 如 图 11-14 所 示 。 


标题 : temp. pdf — Adobe Acrobat Pro 
标题 : 地 学 信息 处 理 方法 . pdf - Adobe Acrobat Pro 


图 11-14 遍历 所 有 打开 的 PDF 文档 


11.5.2 ”AcroAVDOC 对 象 的 属性 和 方法 


AcroAVDOC 对 象 的 属性 和 方法 如 表 11-3 所 示 。 


表 11-3 AcroAVDOC 对 象 的 属性 和 方法 
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属性 或 方法 名 称 功 能 
BringToFront 把 文档 前 置 
ClearSelection/ShowTextSelect 清除 选择 / 显示 选择 
Open/Close 打开 /关闭 文档 
FindNext 查找 下 一 处 
GetAVPageView 获取 Page 视图 
GetPDDoc 获取 AcroPDDoc 对 象 
GetTitle/SetTitle 获取 / 设置 窗口 标题 
GetViewMode/SetViewMode 获取 /设置 视图 模式 
IsValid 是 否 有 效 的 文档 
GetFrame/SetFrame 获取 /设置 PDF 文档 窗口 的 位 置 
PrintPages 打印 指定 的 页 码 范 围 


下 面 的 过 程 使 用 AcroAVDoc 的 Open 方法 打开 计算 机 中 的 一 个 PDF 文档 。 


Sub 打开 PDF 文件 () 
Dim APP As Acrobat.AcroApp 
Dim Doc As Acrobat .AcroRAVDoc，Result As Boolean 
Set App = GetObject("", "AcroExch.App") 
App .Show 
Set Doc = GetObject("", "AcroExch.AVDoc") 
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With Doc 
Result = .Open("C:\temp\temp.pdf", "") 
IE Result Or Doc.IsValid Then 

MsgBox "成功 打 开 ! "，vbInformation 

End If 
.BringToFront 
-Maximize True 

End With 

End sub 


代码 分 析 : Set Doc = GetObject("". "AcroExch.AVDoc") 这 句 ， 也 可 以 换 成 Set Doc = 
CreateObject ("AcroExch.AVDoc")， 用 来 创建 一 个 新 的 AcroAVDoc 对 象 。 

执行 Open 方法 后 ， 返 回 一 个 布尔 值 ， 如 果 打 开 成 功 ， 则 Result 是 True， 同 时 IsValid 
属性 也 是 True。 

关闭 PDF 文 件 ， 可 以 使 用 AcroAVDoc 的 Close 方 法 关闭 ， 也 可 以 使 用 AcroApp 的 
CloseAllDocs 关闭 所 有 文件 。 

假设 现在 Acrobat 软件 中 打开 了 一 个 以 上 的 PDF 文件 ， 执 行 如 下 过 程 ， 首 先 关闭 当前 
活动 PDF 文件 ， 然 后 关闭 所 有 文件 。 


Sub 关闭 PDF 文件 () 
Dim App Rs Acrobat.AcroApp 
Dim Doc As Acrobat.AcroAVDoc, Result As Boolean 
Set App = GetObject("", "AcroExch.App") 
App.Show 
Set Doc = App.GetActiveDoc 
Doc.Close bNoSave:=True 
App.CloseAllDocs 
End Sub 


代码 分 析 : Doc.Close bNoSave:=True 表示 关闭 时 不 保存 修改 。 


11.5.3 ”清除 选择 和 显示 选择 


在 浏览 PDF 文件 的 时 候 ， 用 鼠标 选中 一 个 内 容 区 域 后 ， 可 能 翻 页 到 其 他 页 面 ， 此 时 使 
用 AcroAVDoc 的 ShowTextSelect 方法 可 以 快速 跳 转 到 鼠标 选中 的 区 域 。 
同时 ， 使 用 ClearSelection 还 可 以 取消 选择 。 


Sub 清除 选择 与 显示 选择 () 
Dim App As Acrobat.AcroApp 
Dim Doc As Acrobat.AcroAVDoc 
Set App = GetObject("", "AcroExch.App") 
App.Show 
Set Doc = App.GetActiveDoc 
Doc.ShowTextSelect 
MsgBox "下面 将 自动 清除 选择 。" 
Doc.ClearSelection 

End Sub 


11.5.4 
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在 PDF 文件 中 查找 内 容 


使 用 AcroAVDoc 对 象 的 FindNext 方 法 ， 可 以 实现 自动 在 PDF 文件 中 查找 指定 的 文字 ， 
如 果 找 到 ， 返回 True， 并 且 在 PDF 文件 中 自动 跳 转 到 目标 位 置 。 
FindNext 方法 有 4 个 需要 指定 的 参数 : 查找 关键 词 、 是 否 区 分 大 小 写 、 是 否 整 词 匹配 、 


是 否 从 头 查找 。 
下 面 的 过 程 在 当前 活动 PDF 文档 中 查找 “Python ”。 
Sub 查找 内 容 () 


=False, 


Dim App As Acrobat.AcroApp 
Dim Doc As Acrobat.AcroAVDoc 
Dim result As Boolean, i As Integer 
Set App = GetObject("", "AcroExch.App") 
App.Show 
Set Doc = App.GetActiveDoc 
For i=1 To 10 

result = Doc.FindText (szText:="Python", bCaseSensitive:=True, bWholeWordsOnly: 
bReset:=False) 

If result = False Then Exit For 
Next i 


End Sub 

代码 分 析 : 上 述 实例 中 ， 设 置 为 查找 前 10 个 关键 词 ， 每 查找 到 一 个 ， 在 PDF 文件 中 会 
自动 选中 并 跳 转 到 目标 位 置 。 如 果 参 数 bReset 是 True， 则 每 次 都 从 文档 开头 处 查找 ， 查 到 
的 10 个 都 是 头 一 个 位 置 。 


11.5.5 


获取 和 设置 PDF 标题 文字 


AcroAVDoc 对 象 的 GetTitle 和 SetTitle 用 来 获取 和 设置 PDF 文件 的 Title 属性 。 


Sub 获取 和 设置 标题 文字 () 


Dim App As Acrobat.AcroApp 

Dim Doc As Acrobat.AcroAVDoc 

Dim result As Boolean, i As Integer 
Set App = GetObject("", "AcroExch.App") 
App .Show 

Set Doc = App.GetActiveDoc 

Debug.Print Doc.GetTitle 

Doc.SetTitle "开心 一 刻 " 

Debug.Print Doc.GetTitle 


End Sub 


运行 上 述 代码 后 ，Acrobat 的 左上 角 标 题 被 更 改 ， 如 图 11-15 所 示 。 


图 11-15 ”获取 和 修改 标题 
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11.5.6 ”获取 和 设置 阅览 模式 


AcroAVDoc 的 GetViewMode 和 SetViewMode 用 来 获取 和 设置 阅览 视图 模式 。 
运行 下 面 的 过 程 ， 使 得 PDF 文件 进入 全 屏 预览 模式 。 


Sub 获取 和 设置 阅览 模式 () 

Dim App As Acrobat.AcroApp 

Dim Doc As Acrobat.AcroAVDoc 

Dim result As Boolean, i As Integer 

Set App = GetObject("", "AcroExch.App") 

App.Show 

Set Doc = App.GetActiveDoc 

Debug.Print Doc.GetViewMode 

Doc.SetViewMode nType:=Acrobat .PDViewMode.PDFullScreen 
End Sub 


代码 分 析 : SetViewMode 的 可 用 参数 来 自 AcrobatPDViewMode 的 枚 举 值 。 


11.5.7 ”获取 和 设置 PDF 文档 窗口 位 置 


AcroAVDOC 对 象 的 GetFrame 返回 一 个 AcroRect 对 象 ， 该 对 象 具有 Left、Top、Right 
和 Bottom 四 个 属性 ， 用 于 返回 PDF 文档 窗口 的 左上 角 、 右 下 角 在 屏幕 上 的 坐标 。 


Sub 获取 和 设置 PDF 文档 窗口 位 置 () 
Dim App Rs Acrobat.AcroApp 
Dim Doc As Acrobat.AcroAVDoc 
Dim result As Boolean, i As Integer 
Dim Rect As Acrobat.AcroRect 
Set App = GetObject("", "AcroExch.App") 
App.Show 
Set Doc = App.GetActiveDoc 
Set Rect = Doc.GetFrame 


With Rect 
Debug.Print .Left, .Top, .Right; .bottom 
End With 
MsgBox " 接 下 来 自动 设置 Acrobat 窗口 位 置 ! " 
With Rect 
.Left = 200 
.Top = 220 


.Right = 1000 
-bottom = 600 
End With 
Doc.SetFrame Rect 
End Sub 


运行 以 上 代码 ， 首 先 打 印 出 当前 PDF 文档 窗口 的 所 在 位 置 ， 然 后 重 设 位 置 。 


11.5.8 打印 或 另存 PDF 文档 


AcroAVDoc 对 象 的 PrintPages 方法 会 在 Acrobat 中 自动 弹出 打印 对 话 框 ， 如 果 计 算 机 中 
没有 找到 可 用 的 打印 机 ， 则 另存 为 PDF 文档 。 
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下 面 的 代码 打印 活动 文档 的 第 2 ~ 5 页 。 


Sub 打印 PDF 文档 () 
Dim App As Acrobat.AcroApp 
Dim Doc Rs Acrobat.AcroAVDoc 
Dim result As Boolean, i As Integer 
Dim Rect As Acrobat.AcroRect 
Set App = GetObject("", "AcroExch.App") 
App .Show 
Set Doc = App.GetActiveDoc 
Doc.PrintPages nFirstPage:=2, nLastPage:=5, nPSLevel:=2, bBinaryOK:=False, 

bshrinkToFit:=False 
End Sub 


以 上 内 容 的 源 代码 文件 为 “实例 文档 71.xlsm”。 
AcroAVDoc 对 象 的 GetPDDoc 属性 用 来 获取 一 个 AcroPDDoc 对 象 ，GetAVPageView 属性 
用 来 获取 一 个 AcroAVPageView 对 象 ， 下 面 分 别 介绍 。 


11.6 AcroAVPageView 对 象 


AcroAVPageView 对 象 可 以 对 Acrobat 文档 的 视图 和 浏览 方式 进行 访问 和 设 定 ， 比 较 常 
用 的 方法 和 属性 如 下 。 

口 GetPageNum/GoTo， 获 取 文档 当前 页 码 / 跳 转 到 某 页 。 

口 GetZoom/ZoomTo， 获 取 / 设置 当前 缩放 比例 。 

口 ReadPageDown/ReadPageUp， 跳 转 到 下 一 页 /上 一 页 。 

下 面 的 代码 获取 文档 当前 页 码 并 自动 跳 转 到 指定 的 页 面 。 然 后 更 改 视图 缩放 比例 。 


Sub 更 改 PDF 文档 视图 () 
Dim App Rs Acrobat.AcroApp 
Dim Doc Rs Acrobat.AcroAVDoc 
Dim APV As Acrobat.AcroAVPageView 
Set App = GetObject("", "AcroExch.App") 
App .Show 
Set Doc = App.GetActiveDoc 
Set APV = Doc.GetAVPageView 
With APV 
Debug.Print " 当前 页 码 : "， .GetPageNum 
-GoTo 6 
Debug.Print " 当前 缩放 比例 : "， .GetZoom 
.ZoomTo Acrobat.AVZzoomType.AVZoomNoVary, 75 ' 缩放 到 75% 
.ReadPageDown ' 按 下 Page Down 键 
.ReadPageUp ' 按 下 Page Up 键 
End With 
End Sub 


运行 上 述 代码 后 ， 可 以 看 到 自动 跳 转 到 第 7 页， 并且 缩放 比例 为 73%， 如 图 11-16 所 示 。 
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图 11-16 自动 跳 转 和 调整 缩放 比例 
AcroAVPageView 对 象 的 GetPage 属性 返回 一 个 AcroPDPage 对 象 。 


11.7 AcroPDPage 对 象 


AcroPDPage 对 象 是 一 个 针对 “页 ”操作 的 对 象 ， 也 就 是 PDF 文档 中 的 某 一 页 进行 


11.7.1 ”获取 和 更 改 PDF 页 面 旋转 角度 


下 面 的 代码 首先 把 活动 PDF 文档 自动 跳 转 到 第 4 页， 然后 把 当前 页 赋 给 变量 PDPage。 


Sub 更 改 PDF 页 面 旋转 角度 () 
Dim App As Acrobat.AcroApp 
Dim Doc As Acrobat.AcroAVDoc 
Dim APV As Acrobat.AcroAVPageView 
Dim PDPage As Acrobat.AcroPDPage 
Set App = GetObject("", "AcroExch.App") 
App.Show 
Set Doc = App.GetActiveDoc 
Set APV = Doc.GetAVPageView 
APV.GoTo 4 
Set PDPage = APV.GetPage 
With PDPage 
Debug.Print " 当前 页 码 : "， .GetNumber 
Debug.Print " 当前 页 面 旋转 角度 : "， .GetRotate 
.SetRotate 180 
End With 
End sub 


代码 分 析 : SetRotate 方法 可 用 的 参数 只 能 是 0、90、180、270 这 四 个 角度 值 。 以 上 代 
码 执行 后 ，PDF 文档 的 第 4 页 倒立 了 起 来 ， 如 图 11-17 所 示 。 
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关 回 和“ 疾 卫 厘 曲 函 昂 “Y 先 消 十 汉 下 省 “也 时 益田 放 各 二 “ 最 四 二 阅 


20999x29598 厘米 此 mm l ’ 


图 11-17 自动 旋转 页 面 


11.7.2 ”删除 注释 


通过 AcroPDPage 对 象 ， 可 以 对 当前 页 面 增加 和 删除 注释 。 注 释 是 PDF 文档 中 的 一 种 
元 素 ， 类 似 于 Office 中 的 批注 功能 。 
下 面 的 代码 删除 活动 PDF 文档 第 4 页 中 的 所 有 注释 。 


Sub 删除 注释 () 
Dim App Rs Acrobat.AcroApp 
Dim Doc Rs Acrobat.AcroAVDoc 
Dim APV As Acrobat.AcroAVPageView 
Dim PDPage As Acrobat.AcroPDPage, i As Integer, Count As Integer 
Set App = GetObject("", "AcroExch.App") 
App .Show 
Set Doc = App.GetActiveDoc 
Set APV = Doc.GetAVPageView 
APV.GoTo 4 
Set PDPage = APV.GetPage 
With PDPage 
Count = .GetNumAnnots 
For i= 1 To Count 
-RemoveAnnot 0 
Next i 
End With 
End Sub 


代码 分 析 : GetNumAnnots 属性 返回 注释 的 个 数 ， 然 后 删除 所 有 注释 。 
假设 代码 运行 前 ， 页 面 如 图 11-18 所 示 。 运 行 上 述 过 程 后 ， 页 面 中 的 3 个 形状 被 移 除 。 
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据 宛 城 ， 伪 引 兵 攻 之 ， 赵 弘 遗 韩 忠 出 战 - 储 遗 辫 德 、 关 、 张 攻 城西 南 角 。 病 忠 尽 率 精锐 之 
众 ， 来 西南 角 抵 敌 。 朱 人 备 自 级 铁骑 二 千 ， 径 取 东 北角 。 贼 悉 失 城 ， 色 弃 西 南面 回 。 支 德 从 青 


后 拖 示 ， 赋 众 大 败 ， 齐 入 帘 城 。 朱 人 分 兵 四 面 围 定 。 城 中 新 扫 ， 草 吕 使 人 出 城 投降 。 信 不 
许 。 支 升 日“ 音 高 组 之 得 天 下 ， 蔓 为 能 招降 纳 顺 | 公 何 拒 埋 中 到 ? ” 储 日 ,“ 锌 一 时 ， 此 
一 时 也 。 音 秦 项 之 际 ,天 下 大 乱 ， 民 无 定 主 ， 故 接 降 贷 形 ， 以 功 玉环， 今 帮 内 一 统 ， 仅 食 由 
造反 车 容 其 际 ， ns ne ri 此 长 寇 之 去 ， 非 良策 也 - 
支 入 日 : “不容 读 旗 是 笑 一 今 不 得 ， 少 然 死 战 。 万 人 一 心 ， 雍 不 可 
当 ， 况 城中 有 数 万 死 全 之 人 平 ? 不 者 描 去 东南 ， 独 攻 西 而 走 ， 无 必 恋 战 ， 可 印 
摘 也 。” 便 注解 马 ， 一 齐 攻打 两 捷 。 昔 员 果 引 军 齐 城 王 春 。 全 与 云 德 、 
关 、 张 素 余 暂 四 豚 萤 走 正 志 直 间 ， 起 六、 孙 促 引 巾 从 到 ， 与 伟 交 
乘势 复 夺 究 城 . 入 离 十 里 下 亭 . 方 台 歌 条 ， 名 见 正 东 一 虎 人 
而 ， 席 体 同 腰 : sie 孙 ， 名 至 ， 闻 文 全， 乃 孙 
武子 之 后 。 第 十 七 区 时 ， 王 交 间 钱塘 ， 见 海 赃 十 余人 ， 动 取 商 人 暑 移 ， 于 岸上 分 赃 。 坚 调 信 
日 “此 央 可 扒 也 , ” 巡 兰 力 提 刀 上 上 岸 ， 搬 声 大 时， 东西 指挥 ， 如 唉 人 杖 。 贼 以 为 宫 兵 至 ， 
尽 弃 财物 械 走 。 坚 赶 上 ， 杀 一 虚 。 由 是 好 县 知名 ， 荐 为 校 尉 。 后 会 箱 括 占 许 昌 造 反 ， 自 称 
“ 阳 朋 皇帝 "聚众 数 万 ， 坚 与 那 司马 招 莫 勇 十 咎 余人 ， 会 台州 各 破 之 ， 斩 许昌 并 其 子 许 
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图 11-18 自动 删除 所 有 注释 


11.7.3 ”提取 页 面 文字 


AcroPDPage 对 象 联合 其 他 对 象 ， 可 以 遍历 页 面 上 的 每 个 字符 ， 从 而 实现 PDF 文档 文字 
提取 的 功能 。 


Sub 提取 页 面 文字 () 
Dim App As Acrobat.AcroApp 
Dim Doc As Acrobat.AcroAVDoc 
Dim APV As Acrobat.AcroAVPageView 
Dim PDPage As Acrobat.AcroPDPage 
Dim AHL As Acrobat.AcroHiliteList 
Dim PDTS As Acrobat.AcropDTextSelect 
Dim i As Long，S Rs String 
Set App = GetObject("", "AcroExch.App") 
App.Show 
Set Doc = App.GetActiveDoc 
Set APV = Doc.GetAVPageView 
APV.GoTo 4 
Set PDPage = APV.GetPage 
With PDPage 
Set AHL = New AcroHiliteList 
AHL.Add 0, 32767 
Set PDTS = .CreateWordHilite (AHL) 
With PDTS 
For i 0 To .GetNumText — 1 
S=S & .GetText(i) 
Next i 
End With 
End With 
Debug.Print S 
End sub 


第 11 章 操作 Acrobat 对 象 323 


代码 分 析 : 上 述 代码 自动 跳 转 到 活动 PDF 文档 的 第 4 页 ， 把 遍历 到 的 字符 连接 到 字符 
串 变量 S 中 ， 最 后 输出 S， 就 是 该 页 的 所 有 文本 内 容 。 

以 上 实例 只 提取 了 一 页 的 内 容 ， 如 果 要 提取 PDF 文档 所 有 页 面 内 容 ， 只 需要 在 外 层 再 
套 一 个 循环 页 码 ， 就 可 以 实现 ， 如 果 把 输出 的 字符 串 发 送 到 Excel 或 Word， 就 实现 了 PDF 
转 Office 文档 的 功能 。 

如 果 要 在 不 打开 PDF 文档 的 前 提 下 实现 转换 ， 可 以 用 AcroPDDoc 对 象 在 后 台 打 开 PDF 
文档 ， 然 后 使 用 AcroPDDoc.AcquirePage(i) 的 方式 返回 第 i 页 的 AcroPDPage 对 象 即 可 。 

以 上 内 容 的 源 代码 文件 为 “实例 文档 73.xlsm”。 


11.8 AcroPDDoc 对 象 


AcroPDDoc 对 象 可 以 在 后 台 操 作 PDF 文件 ， 也 就 是 不 需要 AcroApp 对 象 。 
AcroPDDoc 对 象 与 AcroAVDoc 比较 ， 包 含 的 属性 和 方法 有 很 多 不 同 ， 例 如 AcroPDDoc 
对 象 可 以 对 PDF 文件 中 的 页 面 进 行 增加 、 删 除 和 替换 操作 。 


11.8.1 获取 和 修改 PDF 文件 属性 
下 面 的 过 程 获取 一 个 PDF 文件 的 属性 ， 实 现 流程 是 : 打开 一 获取 一 关闭 。 


Sub 后 台 获取 PDF 文件 信息 () 

Dim PD As Acrobat.AcroPDDoc, result As Boolean 

Set PD = GetObject("", "AcroExch.PDDoc") 

With PD 
.Open "C:\temp\ 三 国 演义 .pdf" 
Debug.Print "文件 名 : "， .GetFileName 
Debug.Print "总 页 数 "， .GetNumPages 
Debug. Print "Title: ", .GetInfo{("Title") 
Debug.Print "Creator: ", .GetInfo("Creator") 
Debug.Print "Keywords: ", .GetInfo("Keywords") 
Debug.Print "Subject: ", .GetInfo("Subject") 
Debug.Print "Author: ", .GetInfo("Author") 
Debug.Print "Created: ", .GetInfo("Created") 
Debug.Print "Modified: ", .GetInfo("Modified") 
Debug.Print "Producer: ", .GetInfo("Producer") 


:Close 
End With 文件 名 : 三 国 演义 . pdf 
End sub 总 页 数 10 
Title: 刘 永 富 用 VBA 生 成 的 小 说 
运行 上 述 过 程 ， 立 即 窗口 的 结果 如 图 11-19 人 te 2013 
eywords: Ey 
所 示 。 Subject: 三 国 演义 前 10 页 
Author: 刘 永 语 
Acrobat 软件 打开 该 PDF 文件 ， 单 击 菜单 Cronted: 
lodified: 
【文件 /属性 ]， 可 以 看 到 该 文档 的 PDF 属性 与 Producer: Microsoft?Word 2013 


VBA 执行 的 结果 是 一 致 的 ， 如 图 11-20 所 示 。 
图 11-19 获取 PDF 文档 信息 
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es 


安全 住 [ 字 休 | 初 过 视 峡 定义 | 高 妥 | 


文件 : 三国 演义 pdf 
标本 : ”网 I 丰富 用 VBA 和 89 小 沿 


作者 (A : 风 订 富 


创建 昌 期 2018/2/10135552 
修改 日 期 : 2018/2/1014:1433 


应 用 有 序 : Miaosoft@ Word 2013 


PDF 制 人 性 序 ;Microsoft@ Word 2013 
PDF 版 本 : 15 Acrobat6og 


位 置 : CG\temp\ 
文件 大 小 : 52052 KB (533118 字 节 ) 
页 面 大 小 : 20999x29498 厘米 ma: 1 
加 标签 的 PDF : 否 快速 Web 坦 看 ; 否 
一 一 一 


图 11-20 手工 查看 PDF 文档 属性 
下 面 的 过 程 自动 在 后 台 设置 PDF 文档 的 部 分 属性 。 
Sub 后 台 设 置 PDF 文件 属性 () 


Dim PD As Acrobat.AcroPDDoc, result As Boolean 
Set PD = GetObject("", "AcroExch.PDDoc") 
With PD 
.Open "C:\temp\ 三 国 演义 .pdf" 
.SetInfo "Keywords"，" 水 浒 传 西游 记 " 
.SetInfo "Author", " 刘 行 " 
.Save nType:=Acrobat.PDSaveFlags.PDSaveFull, sFullPath:="C:\temp\ 三 国 演 
义 AddProperties.pdf" 
“Close 
End With 
End Sub 


代码 分 析 : 上 述 代码 更 改 了 关键 词 和 作者 这 两 个 属性 ， 需 要 注意 的 是 ，AcroPDDoc 的 
Save 方法 中 只 能 另存 到 另 一 个 PDF 文档 中 ， 不 能 把 修改 保存 到 本 文档 。 


11.8.2 ”裁剪 页 面 


PDF 文档 的 页 面 可 以 裁剪 ， 所 谓 裁剪 页 面 ， 就 是 在 原先 页 面 中 画 一 个 矩形 框 ， 保 留 矩 
形 框 围 起 来 的 部 分 ,矩形 外 侧 四 周 变 得 不 可 见 。 

在 Acrobat 软件 中 依次 选择 Adobe Acrobat 的 菜单 【文档 /裁剪 页 面 ]， 弹 出 “裁剪 页 面 ” 
对 话 框 。 

从 “裁剪 页 面 ”对 话 框 可 以 看 出 ， 一 般 的 PDF 页 面 的 宽度 约 600 点 ( Points)， 高 度 约 
800 点 ， 如 图 11-21 所 示 。 

使 用 代码 可 以 自动 裁剪 页 面 。AcroPDDoc 对 象 的 CropPages 方法 可 以 同时 裁剪 一 
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档 中 的 多 张 页 面 ，AcroPDPage 对 象 的 CropPage 方法 可 以 裁剪 指定 的 一 页 。 


bEW) 


Ee [| 


大小 
加 固定 大 MD) 。 页面 大 小 G): [无 -| 
© Sex(U) RN: 陆 高 度 (H) : [3 
FO 。 X 妈 风量 ， 二。 Y 妈 纺 和 最 : 5 


图 11-21 “裁剪 页 面 ”对 话 框 
CropPages 方法 的 语法 格式 如 下 。 


Function CropPages (nStartPage Rs Long, nEndPage Rs Long, nOddorEvenPagesOnly 
As Integer, iAcroRect As Object) As Boolean 


参数 说 明 如 下 。 
口 nStartPage 为 开始 页 ， 如 果 从 首页 开始 裁剪 ， 设 为 0。 
口 nEndPage 为 结束 页 ， 如 果 裁 前 到 最 后 一 页 ， 设 为 AcroPDDoc 对 象 的 GetNumPages。 
口 n0ddOrEvenPagesOnly， 可 以 设置 为 0( 开 始 页 到 结束 页 之 间 的 所 有 页 面 )1( 奇 数 页 )、 
2 (偶数 页 )。 
口 iAcroRect 是 一 个 AcroRect 矩形 对 象 ， 该 对 象 需要 在 裁剪 前 创建 ， 并 设置 其 Left、 
Right、Bottom 、Top 属性 ， 用 来 设 定 裁剪 区 域 。 
如 果 裁 前 成 功 ， 则 该 方法 返回 True。 
例如 ，Doc.CropPages(0, 9, 2, rect) 表示 把 第 0、2、4、6、8 页 按照 rect 的 规定 进行 裁剪。 
下 面 讲述 一 下 AcroRect 对 象 的 设 定 方 法 ，PDF 文档 的 某 一 
页 面 放 在 一 个 直角 坐标 系 中 ， 其 中 点 C 的 坐标 为 ( 600.800 )。 
假设 裁 前 区 域 是 由 矩形 ABCD 构成 ,点 A 的 坐标 为 
( 200,300 )。 那 么 裁剪 矩形 对 象 rect 的 Left 和 Right 是 点 A 和 
点 了 的 横 坐 标 ，Bottom 和 Top 是 点 A 和 点 DD 的 纵 坐标 。 按 攻 
照 此 矩形 裁剪 后 ， 该 页 面 只 能 看 到 和 矩形 围 起 来 的 区 域 ( 深 色 
所 示 区 域 )， 如 图 11-22 所 示 。 


D C 


[9 


图 11-22 ”裁剪 区 域 示 意图 
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下 面 的 程序 把 “三 国 演义 .pdf” 文 档 的 偶数 页 进行 裁剪 。 


Sub 裁剪 页 面 () 
Dim SourceFile As String 
Dim PD As Acrobat.AcroPDDoc, rect As Acrobat.AcroRect, result As Boolean 
Dim i As Integer 
Set PD = GetObject("", "AcroExch.PDDoc") 
Set rect = New Acrobat.AcroRect 
SourceFile = "C:\temp\ 三 国 演义 .pdf" 
PD.Open szFullPath:=SourceFile 
With rect 
-Left = 200 'Left 和 Right 是 点 A 和 点 B 的 横 坐 标 
.Right = 600 
.bottom = 300 'Bottom 和 Top 是 点 R 和 点 D 的 纵 坐标 
.Top = 800 
End With 
result = PD.CropPages (0, 9, 2, rect) 
If result Then 
PD.Save nType:=Acrobat.PDSaveFlags.PDSaveFull, sFullPath:="C:\temp\Trim. df" 
End If 
PD.Close 
End Sub 


运行 上 述 程 序 ， 在 文件 夹 中 生成 一 个 Trim.pdf 文件 ， 在 Acrobat 中 打开 后 ， 可 以 看 到 从 
首页 起 ， 每 隔 一 页 被 裁剪 ， 裁 前 后 的 页 面 显然 变 小 ， 如 图 11-23 所 示 
(Trimpdf - Adobe Acrobat Pro ey) 


| 文 4 妨 强 (E) 视图 (V) 文档 (D) 注释 (O 〇 事 单 (R) 工具 (T) 高 级 (A) 瘟 口 W) 帮助 (H) x 
会 上 页 晤 下 页 3 /10 | 周 iR | 可 5 


图 11-23 ”批量 裁剪 偶数 页 

需要 注意 的 是 ， 页 面 被 裁 前 后， 裁剪 掉 的 边缘 部 分 仍然 在 文档 中 ， 只 是 看 不 见 了 而 已 ， 

如 果 要 把 裁剪 了 的 页 面 还 原 为 初始 状态 ， 只 需要 把 AcroRect 对 象 的 Left 和 Bottom 都 设置 为 
0，Right 和 Top 都 设置 为 页 面 初始 宽度 和 初始 高 度 ， 再 执行 一 次 CropPages 方法 即 可 。 
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11.8.3 ”删除 页 面 


AcroPDDoc 对 象 的 DeletePages 方法 可 以 删除 PDF 文档 中 指定 页 码 范围 的 页 面 。 


Sub 删除 页 面 () 
Dim PD As Acrobat.AcroPDDoc, Doc Rs Acrobat.AcroAVDoc 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open "C:\temp\ 三 国 演义 .pdf" 
Debug.Print PD.GetFileName 
result = PD.DeletePages (nStartPage:=3, nEndPage:=6) 
Set Doc = PD.OpenAVDoc("") 
Doc.Close bNoSave:=False 
End Sub 


上 述 过 程 执 行 后 ， 原 来 10 页 的 PDF 文档 ， 删 除 其 中 第 3 ~ 6 页 ， 也 就 是 删除 实际 的 第 
4 ~ 7 页 。 
PD.OpenAVDoc("") 表示 在 Acrobat 中 显示 该 文档 ， 最 后 保存 。 


11.8.4 ”移动 页 面 


AcroPDDoc 对 象 的 MovePage 方法 可 以 调整 PDF 文档 中 指定 页 面 的 位 置 。 


Sub 移动 页 面 () 
Dim PD As Acrobat.AcroPDDoc, Doc As Acrobat.AcroAVDoc 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open "C:\temp\ 三 国 演义 .pdf" 
result = PD.MovePage (lMoveAfterThisPage:=5, lPageToMove:=2) 
Set Doc = PD.OpenAVDoc("") 
Doc.Close bNoSave:=False 


End Sub 
以 上 代码 把 文档 中 原来 的 第 2 页 移动 为 第 5 页 ， 也 就 是 实际 文档 的 第 3 页 移动 到 第 6 页 
的 位 置 。 


有 些 情况 下 ， 需 要 把 现 有 PDF 文档 中 各 个 页 面倒 序 排列 。 运 行 下 面 的 代码 可 以 把 一 个 
PDF 文档 各 个 页 面倒 序 重新 排列 。 


Sub 倒序 重 排 () 


Dim PD As Acrobat.AcroPDDoc, Doc As Acrobat.AcroAVDoc, result As Boolean 
Dim count As Integer, i As Integer 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open "C:\temp\ 三 国 演义 .pdf" 
count = PD.GetNumPages 
Set Doc = PD.OpenAVDoc("") 
For i = count - 2 To 0 Step -1 
result = PD.MovePage (lMoveAfterThisPage:=count - 1, lPageToMove:=i) 
Next i 
End sub 


代码 分 析 : 由 于 MovePage 方法 的 参数 IMoveAfterThisPage 表示 放置 于 哪 一 页 之 后 ， 因 
此 需要 从 倒数 第 2 页 开始 依次 放 到 文档 尾部 。 


钢 。office VBA 开发 经 典 一 中 级 进 阶 郑 


11.8.5 ”插入 页 面 


AcroPDDoc 对 象 的 InsertPages 方法 可 以 把 其 他 PDF 文档 中 的 若干 页 面 插入 现 有 了 PDF 
文档 中 。 该 方法 的 语法 如 下 。 


Function InsertPages (nDInsertPageRAfter As Long, iPDDocSource As Object， 
lstartPage As Long, lNumPages Rs Long, lInsertFlags As Long) Rs Boolean 


例如 result = FileA.InsertPages(nInsertPageAfter:=3, iPDDocSource:=FileB, lStartPage:=0, 
INumPages:=2, lInsertFlags:=0) 的 含义 是 在 文件 FileA 的 第 3 页 后 面 插入 文件 FileB 的 第 0 页 
之 后 的 连续 2 页 。 

如 果 插入 页 面 成 功 ， 则 返回 布尔 值 True。 

下 面 的 代码 依次 打开 “三 国 演义 pdf” 和 “西游 记 .pdf”"， 然 后 把 “西游 记 .pdf ”文档 
的 所 有 页 面 插入 “三 国 演义 .pdf” 的 第 3 页 以 后 。 


Sub 插入 页 面 () 
Dim PD As Acrobat.AcroPDDoc, Doc As Acrobat.AcroAVDoc, result As Boolean 
Dim xyj As Acrobat.AcroPDDoc 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open "C:\temp\ 三 国 演义 .pdf" 
Set xyj = GetObject("", "AcroExch.PDDoc") 
XYyj .Open "C:\temp\ 西游 记 .pdf" 
result = PD.InsertPages(nInsertPageAfter:=3, iPDDocSource:=xyj, lStartPage:= 
0, lNumPages:=xyj.GetNumPages, lInsertFlags:=True) 
Set Doc = PD.OpenAVDoc("") 
Doc.Close bNoSave:=False 
End Sub 


也 可 以 把 一 个 PDF 文档 中 的 一 部 分 页 面 分 离 出 去 形成 新 文档 。 
下 面 的 程序 创建 一 个 空白 文档 ， 然 后 把 “三 国 演义 .pdf ”文档 的 前 3 页 插入 新 文档 中 。 
Sub 分 离 部 分 页 面 () 


Dim PD As Acrobat.AcroPDDoc, NewDoc As Acrobat.AcroPDDoc, result As Boolean 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open "C:\temp\ 三 国 演义 .pdf" 
Set NewDoc = New Acrobat.AcroPDDoc 
NewDoc.Create ' 创建 空白 PDF 文档 
result = NewDoc.InsertPages (nInsertPageAfter:=-1, iPDDocSource:=PD, lStartPage:=0, 
lNumPages:=3, lInsertFlags:=0) 
If result Then 
NewDoc .Save nType:=Acrobat.PDSaveFlags.PDSaveFull, sFullPath:="C:\temp\ 
NewDoc .pdf™" 
NewDoc .Close 
End If 
PD.Close 
End sub 


运行 上 述 程序 ， 在 磁盘 下 生成 一 个 NewDoc.pdf， 该 文档 有 3 个 页 面 。 
因此 ， 巧妙 利 用 InsertPages 方法 ， 既 可 以 把 一 个 大 文档 拆 分 为 多 个 小 文档 ， 也 可 以 把 
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计算 机 中 的 多 个 PDF 文档 插入 一 个 文档 中 ， 实 现 文档 合并 的 目的 。 
11.8.6 ” 拆 分 文档 


假设 “三 国 演义 .pdf” 文 档 共有 10 页 ， 现 在 要 求 每 2 页 形成 一 个 小 文档 ， 例 如 第 1 ~ 2 
页 形成 “12.pdf"， 第 3 ~ 4 页 形成 “34.pdf"， 以 此 类 推 。 
实现 的 原理 是 ， 首 先 打 开源 文档 ， 然 后 在 循环 体 中 创建 新 文档 、 插 和 页面 、 关 闭 文档 。 


Sub 拆 分 文档 () 
Dim PD As Acrobat.AcroPDDoc, Doc Rs Acrobat.AcroPDDoc, result Rs Boolean 
Dim i As Integer 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open szFullPath:="C:\temp\ 三 国 演义 .pdf" 
For i = 1 To PD.GetNumPages Step 2 
Set Doc = New AcroPDDoc 
Doc.Create 
result = Doc.InsertPages (nInsertPageAfter:=-1, iPDDocSource:=PD, lStartPage:= 
i - 1, lNumPpages:=2, lInsertFlags:=0) 
Doc.Save nType:=Acrobat .PDSaveFlags.PDSaveFull, sFullPath:="C:\temp\" 
让 呈 
Doc.Close 
Next i 
PD.Close 
End Sub 


运行 上 述 程 序 ， 在 文件 夹 中 生成 5 个 以 数字 命名 的 小 文档 ， 每 个 文档 包含 2 页 ， 如 图 
11-24 所 示 。 


HRM RRC)» emp » 四 加 中 2 
= a ss 

打开 ”电子 邮件 ”新建 文件 实 
名 称 个 改 日期 a 大 小 
国 12pdf 2018/5/9 2201 。 PDF 文件 488 KB 
[34pdf 2018/5/9 22:01 PDF 文件 487 KB| 
56pdf 2018/5/9 2201 ”PDF 文件 349 KB 
固 78pdf 2018/5/9 22:01 PDF 文件 487 KB 
B910pdf 2018/5/9 2201 PDF 文件 349 kB 


图 11-24 自动 拆 分 文档 


11.8.7 合并 文档 


合并 文档 是 把 计算 机 中 已 存在 的 多 个 PDF 文档 的 所 有 页 面 插入 一 个 文档 中 。 
下 面 的 程序 首先 创建 一 个 空白 文档 ， 然 后 在 循环 结构 中 依次 打开 每 个 PDF 文档 ， 每 打 
开 一 个 ， 就 把 全 部 内 容 插入 空白 文档 中 ， 最 后 保存 、 关 闭 所 有 文档 。 


Sub 合并 文档 () 
Dim PD As Acrobat.AcroPDDoc, Doc As Acrobat.AcroPDDoc, result As Boolean 
Dim Files As Variant 
Dim i As Integer 
Set Doc = New AcroPDDoc 
Doc.Create 
Files = Array("C:\Private\l.pdf", "C:\Private\5.pdf", "C:\Private\8.pdf") 
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For i = 0 To UBound(Files) 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open szFullPath:=Files (i) 
result = Doc.InsertPages (nInsertPageAfter:=Doc.GetNumPages - 1, iPDDocSource:= 
PD, lstartPage:=0, lNumPages:=PD.GetNumPages, lInsertFlags:=0) 
PD.Close 
Next i 
Doc.Save nType:=Acrobat .PDSaveFlags.PDSaveFull, sFullPath:="C:\Private\Doc.pdf" 
Doc.Close 
End Sub 


运行 上 述 程序 ， 在 磁盘 下 生成 一 个 DOC.pdf 文件 ， 该 文件 中 的 内 容 是 原先 3 个 PDF 文 
档 合 并 的 结果 。 


11.8.8 ”替换 页 面 


AcroPDDoc 对 象 的 ReplacePages 方法 与 InsertPages 非常 类 似 ， 可 以 把 其 他 的 PDF 文档 
中 的 若干 页 面 插入 现 有 PDF 文档 中 。 与 InsertPages 方法 的 区 别 是 ,插入 的 新 页 面 会 代替 旧 
的 页 面 。 
下 面 的 代码 把 “西游 记 .pdf” 文 档 中 从 第 2 页 开始 连续 的 3 页 替换 “三 国 演义 .pdf” 文 
档 中 第 4 页 开始 的 连续 3 页 。 
Sub 替换 页 面 () 
Dim PD As Acrobat.AcroPDDoc, Doc As Acrobat.AcroAVDoc, result As Boolean 
Dim xyj As Acrobat.AcroPDDoc 
Set PD = GetObject("", "AcroExch.PDDoc") 
PD.Open "C:\temp\ 三 国 演义 .pdf" 
Set xyj = GetObject("", "AcroExch.PDDoc") 
xyj .Open "C:\temp\ 西游 记 .pdf" 
result = PD.ReplacePages (nStartPage:=4, iPDDocSource:=xyj, lStartSourcePage:= 
2, lNumPages:=3, bMergeTextAnnotations:=False) 
Set Doc = PD.OpenAVDoc("") 


Doc.Close bNoSave:=False 
End Sub 


运行 上 述 过 程 后 ,“ 三 国 演义 .pdf” 文 档 的 第 4、5、6 页 连续 3 页 变 成 “西游 记 .pdf” 
文档 中 的 3 页 。 

AcroPDDoc 的 AcquirePage 属性 还 可 以 返回 一 个 AcroPDPage 对 象 。 

以 上 内 容 的 源 代码 文件 为 “实例 文档 72.xlsm”。 


11.9 本章 小 结 


Acrobat 是 一 个 用 来 查看 和 编辑 PDF 文档 的 专业 软件 ， 安 装 了 该 软件 后 在 计算 机 中 产生 
Acrobat 对 象 库 ， 便 于 在 其 他 编程 语言 中 调用 。 

使 用 AcroApp 应 用 程序 对 象 和 AcroAVDOC 文档 对 象 ， 可 以 自动 打开 、 关 闭 PDF 文 
档 ， 也 可 以 获取 、 设 置 PDF 文档 的 有 关 属 性 。 
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自动 发 送 邮件 


邮件 的 收发 是 现在 日 常 办 公 不 可 缺少 的 一 部 分 工作 ， 特 别 是 在 大 型 企业 中 ， 人 与 人 之 间 
的 邮件 往来 非常 频繁 。 再 加 上 邮件 的 到 达 和 发 送 具有 不 确定 性 的 特点 ， 因 此 人 工 每 天 应 对 这 
些 邮 件 是 非常 烦琐 的 。 
如 果 在 办 公 计 算 机 上 安装 了 Outlook， 配 置 好 账户 后 ， 就 可 以 利用 Outlook VBA 自动 发 
送 邮 件 ， 也 可 以 自动 处 理 接收 到 的 邮件 。 
但 是 考虑 到 很 多 没有 用 过 Outlook， 也 不 太 知 道 如 何 配置 账户 ， 因 此 本 章 介绍 用 
CDOMessage 这 个 外 部 引用 ， 从 而 达到 用 VBA 自动 发 送 邮件 的 目的 。 
如 果 调 用 Outlook 发 送 邮 件 ， 那 么 代码 所 在 计算 机 必须 事先 配置 好 Outlook 账户 才 行 ， 
但 使 用 CDOMessage， 计 算 机 有 代码 就 够 了 ， 也 就 是 说 ， 邮 箱 的 配置 过 程 在 VBA 代码 中 
完成 。 
然而 ， 无 论 是 哪 一 种 方式 代 发 邮件 ， 必 须 通 过 网 页 浏览 器 进入 邮箱 ， 手 工 进行 相关 设 
置 ， 开 启 邮箱 的 SMTP 服务 才 行 ， 如 果 不 开 启 SMTP 服务 ， 只 能 从 网 页 浏览 器 登录 邮箱 ， 
手工 发 信 。 
本 章 用 到 的 外 部 引用 和 重要 对 象 ; 
口 Microsoft CDO for Windows 2000 Library 
> CDO.Configuration 
> CDO.Message 


12.1 开启 POP3/SMTP 服务 


SMTP (Simple Mail Transfer Protocol) 即 简单 邮件 传输 协议 它 是 一 组 用 于 由 源 地 址 到 
目的 地 址 传送 邮件 的 规则 ， 由 它 来 控制 信件 的 中 转 方式 。SMTP 协议 属于 TCP/IP 协议 簇 ， 
它 帮 助 每 台 计 算 机 在 发 送 或 中 转 信件 时 找到 下 一 个 目的 地 。 通 过 SMTP 协议 所 指定 的 服务 
器 ， 就 可 以 把 E-mail 寄 到 收 信人 的 服务 器 上 ， 整 个 过 程 只 要 几 分 钟 。SMTP 服务 器 则 是 遵循 
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SMTP 协议 的 发 送 邮件 服务 器 ， 用 来 发 送 或 中 转发 出 的 电子 邮件 。 
简单 地 说 ，POP 是 用 于 接收 邮件 ，SMTP 用 来 发 送 邮件 。 开 启 SMTP 服务 是 为 了 获得 
用 程序 自动 发 信 的 许可 ， 下 面 介绍 几 个 常用 邮箱 的 SMTP 设置 方法 。 


12.1.1 QQ 邮箱 的 SMTP 设置 


下 面 以 19488012@qq.com 这 个 账户 为 例 ， 讲 述 一 下 如 何 开启 SMTP 服务 。 
首先 从 浏览 器 使 用 邮箱 账户 和 密码 登录 邮箱 ， 进 入 邮箱 后 单 击 【 设置 /账户 ]， 如 
图 12-1 所 示 。 


HH Liu<19488012@qq.com>v @ 
MO@il9 


mail.qq-com 。 岂 箱 首页 | | 


常规 | 帐户 | 换 睦 。 收 信 规 则 反 垃 圾 ”文件 夹 和 标签 其 他 邮箱 ”我 的 订阅 ”信纸 。 体验 室 


图 12-1 邮箱 账户 设置 


向 下 滚动 到 【 POP3/SMTP.. 服务 ]， 检 查 【 POP3/SMTP 服务 】 是 不 是 处 于 “已 开启 ” 
状态 ， 如 果 是 关闭 状态 ， 则 单 击 “ 开 启 ”， 如 图 12-2 所 示 。 


POP3/IMAP/SMTP/Exchange/ CardDAV/CalDAV 了 服务 
开局 服务 : [POP3/SMTP 服 务 (0 同仁 用 Foxmail 等 软件 收 尖 包 件 ?]) EE 
IMAP/SMTP 服 务 (什么 是 IMAP ， 记 又 是 如 何 设置 3) Ex 同 | 开局 
Exchange 服 务 (什么 是 Exchange , 它 又 明和 如 何 各 置 ?] Bx | 开启 
星 款 邮件 友 CardDAV/CalDAV 服 务 (什么 显 CardDAVCalDAV ， 亡 又 是 如 何 设置 ?) BT | 开局 
Depts (POP3/IMAP/SMTPJCardDAV/CalDAV 服 务 均 支 持 SSL 和 连接 .如何 设置 ?) 
草 沿 条 
已 发 送 训 闫 提 示 : 在 蔽 三 方 登 录 QQ 如 箱 ,可 能 存 在 好 件 港 各 风险 , 天 至 旬 害 Apple 1D 安 全 ,建议 使 用 QQ 好 秆 手机 版本 好 
Base 引 坟 5 取 括 权 玛 葬 录 和 二 方 寿 户 包 训 征 人。| 生 所 授权 三 


图 12-2 开启 邮箱 的 SMTP 服务 


更 改 设置 后 ， 看 一 下 网 页 页 面 顶端 或 底 端 是 否 有 【 保存 】 按钮 如 果 有 ， 单 击 保存 从 而 
让 更 改 生 效 。 

对 于 QQ 邮箱 或 者 网 易 163 邮箱 ， 用 代码 代 发 邮件 时 ， 不 使 用 邮箱 的 登录 密码 ， 而 是 使 
用 授权 码 。 因 此 ， 当 开启 SMTP 服务 后 ， 一 定 要 单 击 【 生成 授权 码 ]， 有 的 授权 码 是 邮件 服 
务 器 自动 生成 的 一 个 字符 串 ， 有 的 授权 码 是 由 用 户 指定 的 。 


12.1.2 ”查看 邮箱 服务 器 属性 


自动 发 送 邮件 ， 必 须知 道 SMTP 服务 器 的 相关 属性 设置 ， 对 于 QQ 邮箱 ， 单 击 【 如 何 使 
用 Foxmail 等 软件 收发 邮件 ]， 就 可 以 从 浏览 器 中 打开 相关 的 帮助 信息 。 

如 图 12-3 所 示 的 是 Outlook 中 配置 邮箱 的 参数 设 定 。 

可 以 看 到 ，SMTP 服务 器 的 地 址 是 : smtp.qq.com。 
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r 
[ 2 
| Por 和 ImAP 帐户 设置 光 
输入 帐户 的 吉 件 服务 器 设置 人 
用 户 信息 测试 栖 户 设置 
您 的 姓名 (Y): 19488012 | 建议 宏和 S 的 帐户 以 确保 条 目 正确 无 汝 
电子 邮件 地 址 (E): [19488012@aqqcom | 
2 团 单 去 "下 一 步 时 自动 油 二 帐户 设置 (S) 
接收 部 件 服务 器 (]: popaqcom | 
发 送 邮 件 服务 器 (SMTP)(O): [smtp.qq.com ] 
表 录 信息 
用 户 名 (U): 19488012 
密码 (P): ee 
国 记 仁 杰 码 (R) 
团 要 求 使 用 安全 密码 验证 (SPAJ 进 行 登 录 (Q) 
| 
上 一 步 扩 | 荐 = 步 D>] [取消 
| ee 


图 12-3 ”Outlook 邮箱 配置 界面 


在 【其 他 设置 ] 中， 可 以 看 到 使 用 SMTP 发 送 邮 件 的 端口 号 是 465 ( SSL 加 密 )， 如 图 
12-4 所 示 。 


团 此 服务 器 要 求 加 窗 连 接 (SSL)(E) 
发 送 服 务 器 (SMTP)(O): 465 
使 用 以 下 加 密 连 接 类 型 (CO): 
服务 器 超时 (T) 


长 1 分 钟 


贺 在 服务 器 上 保 贸 邮件 的 副本 (L) 
[14 “ 司 天 后 删除 服务 器 上 的 邮件 副本 (R) 
回 删除 "已 策 除 邮件 "时 ， 同 时 删除 服务 器 上 的 副本 (M) 


图 12-4 端口 号 设置 界面 
SSL ( Secure Sockets Layer， 安 全 套 接 层 ) 及 其 继任 者 传输 层 安 全 ( Transport Layer 
Security，TLS) 是 为 网 络 通信 提供 安全 及 数据 完整 性 的 一 种 安全 协议 。 
是 否 要 求 SSL 加 密 ， 所 使 用 的 端口 号 也 有 所 不 同 ， 这 一 点 要 特别 注意 。 
下 面 介绍 其 他 常用 邮箱 的 设置 和 属性 查看 方法 。 
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12.1.3 ”网易 163 邮箱 的 SMTP 设置 


网 易 163 邮箱 也 采用 授权 码 代替 登录 密码 ， 端 口号 是 25， 如 图 12-5 所 示 。 


163 "2%" 心 omeiruzolsea6acom v 四 
m16 
邮箱 军 码 柳 改 E> 授权 码 
委 权 三星 用 二 登录 第 三 方 邮件 专 户 恋 的 所 用 字 码 - 
/TE 适用 于 登录 以 下 服务 : POP3/IMAP/SMTP/Exchange/CardDAV/CalDAV 服 务 , 
来 信 分 类 
人 
讼 得 志 记 活 所 :| 图 开局 
DF#m 本 
由 号 与 部 入 中 必 和 已 户 用 共和 到 请 五 朋 摇 权 机 登录 所 二 方 部 件 宫 广 活 
如 档 安 主导 Ps 
部 入 手机 服务 
局 用 全 用 时 间 
NS 2018-03-02 2215.57 | 未 人 用 
POP3/SMTP/IMAP 
aa | 启用 括 权 局 ， 送 饼 灾 琶 天生 忆 闻 六 安全 沪 雪 ,使 才 地 作客 广 汪 更 安心 ， 了 解 更 多 > > 
这 5 和 
Stia00 


图 12-5 在 163 邮箱 中 获取 授权 码 


12.1.4 日 本 雅虎 邮箱 的 SMTP 设置 


日 本 雅虎 邮箱 的 SMTP 服务 器 为 smtp.mail.yahoo.co.jp，SSL 加 密 端 口号 为 465， 如 图 
12-6 所 示 。 


了 了 儿 夕 一 七 受信 通知 


POP/IMAP7D 七 又 


义 一 儿 Y7 仆 式 堵 一作 一 股 丁 专 行伍 伍 、 次 0D 情 骤 灯 必要 万 节 。 
今 徐 由 参照 用 上 区、 乙 D 必 一 沁 丰 印刷 U、 保 管 U 世 < 大 记 。 


义 一 儿 刀 人 L 又 变更 
LP 
追加 叉 一 儿 也 下 LL 又 
YA 六 一 人 KKL 又 


也 帮 2U 却 了 一 强化 

迷 三 义 一 儿 对 策 

受信 拒 否 

检 D 才 未 UX 一 儿 拒 否 
也 站 2U 王 47 一 /ty 少 
DfLXFIYF 

海外 办 与 四 也 夕 七 又 制 限 


屡 否 
目 支 返 信 
IMAP: 
便利 机 纶 上 廊 告 最 通化 … 也 夕 也 《EE 狼 了 儿 端 未 限定 ) 回 
* iphone/iPad/iPod touch0) 桂 淮 义 一 过 一 起 失 使 \D 方 
卫 力 说 > 上 管理 iphone/ipad/ipod touch 开 四 设 走 方法 
义 一 儿 也 力 补 > 下 "开机 以 外 OD 义 一 二 一 专 反 使 (YD 方 


Android 端 未 避 点 区 IMAP 也 夕 卫 又 万 利用 地 名 


受信 一 儿 (IMAP) 佬 - 


受信 义 一 儿 (IMAP) 通信 方法 


受信 X 一 儿 (IMAP) 术 一 上 秋 
号 


993 


| XU (SMP) He | [smtp.mal yahoo.cop 
这 全 又 = JSMTP) 起 证 方式 SMTP_AUTH 
送信 义 一 儿 〈(SMTP) 通信 方法 | SSL 
光志 (Mp) i P| ss 
T 力 宫 > 名 / 口 乞 T> 名 ryueifu2009 
XxX— 儿 PKLX ryueifu2009@yahoo.co.jp 
| Io-—F Yahoo! JAPAN IDO/CZD 一 上 


演义 一 此 YI 上 (Outlook、Beckyt、 


Thunderbird 想 点 ) 芯 世 利用 〇 场合 仁 、 甘 水 一 卜 计 象 外 上 龙口 未 地。| 


图 12-6 “日 本 雅虎 邮箱 的 SMIP 设置 
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12.2 VBA 中 使 用 CDO 


VBA 编程 中 ， 可 以 使 用 CDO 来 配置 邮箱 并 发 送 邮件 。 
首先 在 VBA 工程 中 添加 引用 “ Microsoft CDO for Windows 2000 Library”， 如 图 12-7 
所 示 。 


引用 - VBAProject 


ee 


[i 
可 使 用 的 引用 A): 
一 | 
浏览 中) 


TcroseEt Activex Data Objects 2.7 ~ 取消 


口 miereseft Activex Data Objects 2.8 

DMicrosoft ActiveX Data Objects 6.0 

DMicrosoft Add-In Designer 

DMicrosoft ADO Ext. 2.8 for DDL sand 

DD Microsoft AD0 Ext. 6.0 for DDL and[ + 
icrosoft AdomdClient Service Comp" 


DMicrosoft Component Services Typel: 
oH | 二 | 
DMicrosoft Connection Designer v6.0 

DMicrosoft DAD 2.5/3.51 Compatibili 。 


Wierosoft ChO for Windows 2000 Library 
定位 :CMWindows\systen32\edosys. dl 
语言 标准 


图 12-7 添加 外 部 引用 


添加 CDO 的 引用 后 ， 就 可 以 使 用 Message 对 象 和 Configuration 对 象 了 ， 其 中 Message 
对 象 用 于 设置 一 封 邮件 ， 而 Configuration 对 象 则 用 于 配置 发 信和 账户 。 


12.2.1 配置 发 信 账 户 


CDO 的 Configuration 对 象 有 很 多 Field ( ADODB 中 的 字段 )， 下 面 的 过 程 用 于 配置 QQ 


Public Mail As CDO.Message, Config As CDO.Configuration 

Sub AccountConfig () 
Const nms Rs String = "http://schemas.microsoft.com/cdo/configuration/" 
Set Config = New CDO.Configuration 
With Config.Fields 


.Item(nms & "smtpusessl") .Value = True " 使 用 SSL 加 密 
.Item(nms & "sendusing") .Value = 2 " 使 用 网 络 上 的 服务 器 
.Item(nms & "smtpserVver") .Value =“smtp.qq.com” "SMTP 服务 器 地 址 
.Item(nms & "smtpserverport") .Value = 25 "端口 号 
.Item(nms & "smtpauthenticate") .Value = 1 "服务 器 认证 方式 
.Item(nms & "sendusername") .Value = "19488012" ' 发 件 人 邮箱 的 用 户 名 
.Item(nms & "sendpassword") .Value "bmcigbnbsyitcbbi"' 账户 密码 或 授权 码 
.Update ' 更 新 属性 

End With 


End Sub 

代码 分 析 : 需要 注意 的 是 ，.Item(nms & "sendusername") = "19488012" 这 一 行 代码 只 需 
要 写 上 邮箱 地 址 @ 符号 前 面 的 部 分 即 可 。 

运行 上 述 过 程 ， 邮 箱 的 配置 信息 就 保存 在 公有 变量 Config 中 。 
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12.2.2 ”创建 邮件 


一 封 邮件 的 组 成 部 分 ， 主 要 包括 如 下 几 部 分 。 

口 发 件 人 的 邮箱 地 址 。 

口 收 件 人 地 址 、 抄 送 地 址 、 密 送 地 址 。 

口 主题 。 

口 正文 主体 ( 纯 文本 或 HTML)。 

口 附件 。 

CDO 中 使 用 Message 对 象 代表 一 封 邮件 ，Message 对 象 除了 设置 上 述 邮 件 的 组 成 部 分 
外 ， 还 需要 关联 到 邮件 的 配置 对 象 Config。 

下 面 的 过 程 自 动 创建 一 封 邮件 并 发 送 。 


Sub CreateMail () 
Set Mail = New CDO.Message 


With Mail 
.Configuration = Config ' 与 配置 关联 
.From = "19488012@qq.com" ' 发 件 人 邮箱 


.To = "32669315@qq.com" 
.CC = "32669315@qq.com" 
.BCC = "32669315@qq.com" 
.Subject = "使 用 CDoO 代 发 QQ 邮箱" ' 邮件 主题 
' .TextBody = " 上班 通知 : 下 周一 统一 放假 ! " ， 常规 文本 内 容 作为 邮件 正文 
.HTMLBody = "<hl> 多 彩 邮 件 </hl><br/>" & "<a href='http://vba.mahoupao.net/ 
forum.php'> 欢迎 光临 VBA 马后炮 论坛 ! </a>" 
.AddAttachment ("C:\temp\siping.csv") ' 增加 附件 
.AddAttachment ("C:\temp\ 答题 卡 .rar") 
.Send 
End With 
End Sub 


代码 分 析 : 由 于 发 信和 账户 存储 在 公有 变量 Config 中 ， 因 此 ，Mail.Configuration=Config 
就 把 配置 信息 应 用 到 该 邮件 中 。 

代码 中 ，From、To、Subject、TextBody 或 HIMLBody 是 必须 设置 的 属性 。 其 他 要 根据 
实际 情况 进行 增删 。 

运行 上 述 过 程 ， 在 收 件 人 的 邮箱 中 ， 可 以 看 到 这 封 新 邮件 ， 邮 件 的 正文 中 有 一 个 一 级 标 
题 ， 还 有 一 个 超 链 接 ， 如 图 12-8 所 示 。 

以 上 讲述 的 两 个 过 程 ， 其 中 配置 发 件 账户 的 过 程 只 运行 一 次 即 可 ， 而 CreateMail 过 程 
则 可 以 多 次 运行 ， 从 而 发 送 多 封 邮件 。 

如 果 要 使 用 其 他 发 件 人 账户 ,适当 修改 AccountConfig 过 程 即 可 。 下 面 的 过 程 配 置 新 浪 
邮箱 。 

sub RccountConfig () 


Const nms As String = "http://schemas.microsoft.com/cdo/configuration/" 
Set Config = New CDO.Configuration 
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With Config.Fields 


.Item(nms & "smtpusessl") .Value = True “ 使 用 SSL 加 密 
.Item(nms & "sendusing") = 2 " 使 用 网 络 上 的 服务 器 
.Item(nms & "smtpserver") = "smtp.sina.com" "SMTP 服务 器 地 址 
.Item(nms & "smtpserverport") = 25 "端口 号 
.Item(nms & "smtpauthenticate") = 1 " 服务 器 认证 方式 
.Item(nms & "sendusername") = "ryueifu2018" " 发 件 人 邮箱 的 用 户 名 
.Item(nms & "sendpassword") = "liuyongfu" " 账户 密码 或 授权 码 
.Update " 更 新 属性 

End With 


End Sub 


8 QQ 邮箱 rvveifu<32669315@aq.com>* @ 
MG mail.qq.com 邮箱 首页 | 设置 - 琼 著 * 


和 


发 件 人 : Liu <194880128qq.com> 固 
时 同 :2018 年 3 月 3 日 ( 星 鸯 六 ) 上 午 10:35 
收 件 人 : ryueifu <32669315@qq.com> 
抄 送 : ryueifu <32669315@qq.com> 
除 件 ;2 个 ( [0 siping.csv..) 


2 多 彩 邮件 


Eg 
垃 专 守 

QQie 件 订阅 次 迎 光 临 VBA 马 后 雹 论坛 | 
加 我 的 文件 实 

其 人 此 相 附件 (2 介 

在 和 文档 普通 附件 + 全 部 下 载 全 部 收藏 
阳 件 K 硬 siping.csv (209 字 二) 
文件 中 转让 BS ms TE ki NF- 


轰 卡 
田 更 多 应 用 


| 答 要 卡 .rar (92 字 地 ) 
各 | 预 策 下 载 收藏 转 存 


图 12-8 ”使 用 CDO 发 来 的 多 彩 邮 件 


服务 器 地 址 、 端 口号 、 发 件 人 用 户 名 、 密 码 或 授权 码 需 要 修改 。 
然后 基于 上 面 创建 好 的 Config 再 发 一 封 信 。 


Sub CreateMail () 
Set Mail = New CDO.Message 


With Mail 
.Configuration = Config ' 与 配置 关联 
.From = "ryueifu2018@sina.com" ' 发 件 人 邮箱 
.To = "32669315@qq.com" 
.Subject = "使 用 CDO 代 发 新 浪 邮 箱 " " 邮件 主题 
.TextBody = " 上班 通知 : 下 周一 统一 放假 ! " ' 常规 文本 内 容 作为 邮件 正文 
.Send 

End With 

End Sub 


运行 上 述 过 程 ， 收 件 人 邮箱 中 多 了 一 封 邮件 ， 该 邮件 的 正文 是 纯 文本 ， 因 为 代码 中 用 的 
是 TextBody， 如 图 12-9 所 示 。 
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Fg © QQ ryueifu<32669315@qq.com>T @ 
IM 人 ii 敬 


mail.qq-com 。 部 箱 苦 页 | 设置 - 次 鞭 。 


«xa]|| ms |[ ss | #2 | we | me 


使 用 CDO 代 发 新 浪 邮 箱 了 


发 件 人 : ryueifu2018 <ryueifu2018@sina.com> 国 
时 间 : 2018 年 3 月 3 日 (星期 六 ) 中 午 12:20 
收 件 人 : ryueifu <32669315@qq.com> 


上 班 通知 : 下 周一 统一 放假 ! 


[快捷 回 夏 给 : ryueifu2018 


图 12-9 使 用 CDO 代 发 新 浪 邮件 
以 上 内 容 的 源 代码 文件 为 “实例 文档 81.xlsm”。 


12.2.3 ”错误 处 理 


如 果 邮 箱 的 配置 信息 有 问题 ,或 者 邮件 的 各 个 组 成 部 分 不 合适 ， 就 会 导致 Mail 的 Send 
方法 失败 ， 如 图 12-10 所 示 。 
Microsoft Visual Bas 澡 


运行 时 错误 “-2147220973 (80040213)' : 
与 服务 器 的 传输 连接 失败 。 


| 竣 吕 | 线 甸 孝 助 00 | 
图 12-10 ”发 信和 失败 
出 错 后 ， 结 束 程序 运行 ， 根 据 错误 信息 分 析 原 因 并 修改 端口 号 等 属性 重新 尝试 。 


12.2.4” 窗 体 版 的 邮件 客户 端 


在 实际 使 用 中 ， 可 以 把 配置 邮件 的 过 程 、 发 送 邮 件 的 过 程 改 编 成 带 参数 的 形式 ， 从 而 方 
便 调 用 。 例 如 下 面 这 句 。 


Sub MySinaMail (username As String, password As String) 


也 可 以 通过 用 户 窗 体 和 控件 ， 制 作 个 性 化 的 邮件 发 送 系 统 。 笔 者 用 VB6 制作 的 SendMail 
就 是 调用 CDO 对 象 实现 的 ， 如 图 12-11 所 示 。 
可 以 从 本 书 配套 资源 中 下 载 “SendMail rar”。 
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EEC [ES > | 
ND RO) NOH) me = = 
发 f 人 [asaiggyasem 可 本 上 [ga 一 
由 件 人 。 [Paes5515890 eon T17651555384 em 发 入账 户 。 fryoeiFi20098yahoo coip 
EN ly 
:raymisine com an ”应 一 一 
主 看。 属 委 : 再 2 Fe 
np 保存 修 汐 |。 出 4 账 户 | 。 退出 
以 Emp python py ax 
i 四 
厂 习 F 可 后 ss 可 厂 全 有 YX 本 。 发送 
| 这 里 是 正文 。 


图 12-11 窗 体 版 的 邮件 客户 端 


12.3 ”其 他 语言 调用 CDO 


CDO 作为 Windows 系统 的 一 个 公共 对 象 库 ， 除 了 能 在 VBA、VB6 中 引用 以 外 ， 还 可 
以 用 在 .Net 语言 中 。 
只 需要 把 VBA 版 的 代码 的 语法 改编 成 其 他 语言 的 语法 即 可 。 


12.3.1 VB.Net 调 用 CDO 


下 面 的 项 目 在 Visual Studio 中 创建 了 一 个 窗 体 应 用 程序 ， 窗 体 上 放置 一 个 按钮 。 然 后 为 
项 目 添加 “Microsoft CDO for Windows 2000 Library” 的 外 部 引用 。 


Imports CDO 
Public Class Forml 
Private Config As CDO.Configuration 
Private Mail As CDO.Message 
Sub AccountConfig () 
Const nms As String = "http://schemas.microsoft.com/cdo/configuration/" 
Config = New CDO.Configuration 
With Config.Fields 


.Item(nms & "smtpusessl") .Value = True " 使 用 SSL 加 密 
.Item(nms & "sendusing") .Value = 2 '， 使 用 网 络 上 的 服务 器 
.Item(nms & "smtpserver") .Value = "smtp.qq.com" "SMTP 服务 器 地 址 
.Item(nms & "smtpserverport") .Value = 25 "端口 号 
.Item(nms & "smtpauthenticate") .Value = 1 “ 服务 器 认证 方式 
.Item(nms & "sendusername") .Value = "19488012" " 发 件 人 邮箱 的 用 户 名 
.Item(nms & "sendpassword") .Value = "bmcigbnbsyitcbbi" ' 账户 密码 或 授权 码 
-Update () ' 更 新 属性 

End With 


End Sub 
Sub CreateMail () 
Mail = New CDO.Message 
With Mail 
.Configuration = Config ' 与 配置 关联 
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-From = "19488012@qq.com" " 发 件 人 邮箱 
2 "32669315@qq.com" 
-CC = "32669315@qq.com" 
-BCC = "32669315@qq.com" 
.Subject = "使 用 VB.Net 代 发 QQ 邮箱 " " 邮件 主题 
' .TextBody = "上 班 通知 : 下 周一 统一 放假 ! " " 常规 文本 内 容 作为 邮件 正文 
.HTMLBody = "<hl> 多 彩 邮件 </h1><br/>" & "<a href='http://vba.mahoupao. 
net/forum.php'> 欢迎 光临 VBA 马后炮 论坛 ! </a>" 
.AddAttachment ("C:\temp\siping.csv") "增加 附件 
.AddAttachment ("C:\temp\ 答题 卡 .rar") 
-Send 
End With 
End Sub 
Private Sub Button1l_ Click(sender As Object，e As EventRrgs) Handles Buttonl.Click 
Call AccountConfig () 
Call CreateMail () 
End Sub 


启动 窗 体 后 ， 单 击 按钮 ， 邮 件 就 自动 发 送出 去 了 。 


12.3.2 C# 调 用 CDO 


与 VB.Net 类 似 ， 在 Visual Studio 中 创建 一 个 窗 体 应 用 程序 ， 放 置 一 个 按钮 。 为 项 目 添 
加 CDO 这 个 外 部 引用 ， 然 后 在 模块 项 部 添加 指令 : using CDO;。 
按钮 的 单 击 事件 代码 如 下 。 


private void buttonl Click(object sender, EventArgs e) 
{ 
CDO.Configuration Config; 
CDO.Message mail; 
const string nms = "http://schemas.microsoft.com/cdo/configuration/"; 


string username = "19488012"; 
string password = "bmcigbnbsyitcbbi"; 
string smtp = "smtp.qq.com"; 


int port = 465; 

Config = new CDO.Configuration(); 

Config.Fields[nms + "smtpusessl"] .Value = 1; 
Config.Fields [nms + "sendusing"] .Value = 2; 
Config.Fields [nms + "smtpserver"] .Value = smtp; 
Config.Fields [nms + "smtpserverport"] .Value = port; 
Config.Fields [nms + "smtpauthenticate"] .Value = 1; 
Config.Fields [nms + "sendusername"] .Value = username; 
Config.Fields [nms + "sendpassword"] .Value = password; 
Config .Fields.Update () 7 

mail = new CDO.Message(); 

mail.Configuration = Config; 

mail.From = "19488012@qq.com"; 

mail.To = "32669315@qq.com"; 

mail.Subject = "C# 代 发 QQ 邮箱 "; 

mail.TextBody = "仅仅 是 一 个 示例 "; 
mail.AddAttachment (@"C:\temp\ 答题 卡 .rar"); 
mail.Send(); 
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启动 窗 体 ， 并 单 击 按钮 ， 邮 件 正常 发 出 。 


12.4 ”本 音 小 结 


邮箱 只 有 开启 了 POP/SMTP 服务 ， 才 能 让 其 他 程序 调用 。 

不 同类 型 的 邮箱 ，SMTP 发 送 服务 器 、 发 送 端 口号 有 所 不 同 ， 可 以 在 网 页 上 登录 邮箱 后 
查看 到 这 些 信息 。 

使 用 CDO 发 送 邮件 ， 需 要 把 邮箱 的 账户 信息 写 在 程序 代码 中 。 
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网 页 自动 化 


本 章 用 到 的 外 部 引用 和 重要 对 象 : 
口 Microsoft HTML Object Library 
> MSHTIML.HTMLDocument 
口 Microsoft Internet Controls 
> SHDocVw.WebBrowser 
> SHDocVw.InternetExplorer 
口 Microsoft XML., v6.0 
> MSXML2.XMLHTTP60 
口 Microsoft WinHTTP Services, version 5.1 
> WinHttp.WinHttpRequest 


13.1 网 页 自动 化 概述 


Office VBA 编程 ， 从 字面 上 理解 就 是 自动 处 理 Office 文档 和 本 地 文件 的 一 种 技术 手段 。 
但 是 由 于 VBA 可 以 通过 添加 外 部 引用 来 扩展 程序 的 功能 ， 实 现 自动 操作 网 页 、 获 了 到 和 提交 
网 络 资源 也 成 为 可 能 。 

当今 时 代 是 一 个 信息 化 时 代 ， 每 时 每 刻 都 有 大 量 的 数据 信息 通过 电子 邮件 、 远 程 计算 机 
和 服务 器 、 网 页 等 媒介 进行 传输 。 这 样 必然 导致 办 公 人 员 的 工作 不 仅仅 是 编辑 、 打 印 本 地 文 
档 ， 还 要 每 天 从 网 页 上 查询 、 搜 索 有 用 的 信息 。 光 一 个 网 页 上 就 有 成 千 上 万 个 元 素 ， 每 天 用 
眼睛 和 双手 浏览 众多 的 网 页 势必 给 人 们 带 来 巨大 的 压力 。 

因此 ， 实 现 网 页 的 自动 化 操作 ， 解 放 办 公 人 员 的 双手 ， 节 省 人 力 和 时 间 成 本 的 需求 日 益 
受到 关注 ， 网 络 数据 抓 取 和 分 析 也 成 为 诸多 编程 语言 的 热点 。 


13.1.1 ”网 页 自动 化 包含 的 内 容 
网 页 自动 化 的 目的 和 意义 ,就 是 解决 人 们 上 网 的 需求 ， 把 人 和 浏览 器 的 交互 过 程 转换 为 
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程序 代码 。 能 够 实现 的 自动 化 内 容 如 下 。 

口 自动 打开 指定 网 址 的 网 页 。 

口 自动 分 析 网 页 内 容 。 

口 自动 下 载 、 保 存 网 页 资源 。 

口 自动 填写 、 提 交 表单 。 

口 自动 提交 数据 、 自 动 登录 论坛 。 

凡是 和 网 页 、 服 务 器 有 关 的 操作 ， 都 可 以 考虑 使 用 编程 的 方式 代替 手工 操作 。 

网 页 自动 化 与 桌面 程序 自动 化 有 很 大 的 不 同 ， 桌 面 程序 自动 化 主要 靠 API 函数 向 指定 
句柄 的 窗口 或 控件 发 送 鼠标 单 击 或 按键 消息 ， 自 动 化 程序 的 宿主 和 操控 的 对 象 处 于 不 同 的 进 
程 。 虽 然 网 页 自动 化 也 需要 鼠标 和 键盘 操作 ， 但 主要 是 通过 获取 到 网 页 元 素 ， 并 且 直 接 赋值 
或 调用 网 页 元 素 的 方法 实现 自动 化 。 


13.1.2 ”网 页 自动 化 开发 所 需 知识 和 技能 


网 页 是 一 种 相对 “特殊 ”并 且 “ 复 杂 ” 的 对 象 ， 可 以 被 看 成 由 多 种 类 型 的 元 素 构成 的 文 
档 树 ， 其 后 台 语 言 是 HTML, 但 是 表现 给 用 户 的 页 面 是 一 个 五 彩 缤纷 的 多 媒体 世界 。 

虽然 可 以 从 字符 串 的 角度 去 思考 网 页 内 容 ， 但 是 一 般 情 况 下 每 个 网 页 的 源 代码 相当 长 ， 
使 用 一 般 的 字符 串 处 理 技术 分 析 网 页 相当 烦琐 ， 而 且 不 准确 。 

因此 ， 顺 利 开 展 网 页 自动 化 编程 ， 需 要 的 知识 和 技能 如 下 。 

口 HIML 基础 。 

口 HTML DOM 对 象 模型 。 

口 字 符 串 处 理 函 数 和 正则 表达 式 。 

口 会 用 浏览 器 开发 工具 查找 和 分 析 网 页 元 素 。 

口 会 用 浏览 器 开发 工具 获取 网 页 请 求 信息 。 

网 页 的 后 台 是 一 个 以 <html> 开始 、</html> 结束 、 有 一 定 组 织 结构 的 树 状 文档 ， 从 
HTML 的 角度 ,< 和 > 括 起 来 的 称 为 “标签 ” 。 然 而 ， 从 HIML DOM 对 象 的 角度 ， 称 为 “元 
素 ” 更 为 贴切 。 

HTML DOM 是 用 来 描述 一 个 网 页 文档 组 织 结构 的 对 象 ， 通 过 使 用 HIML DOM 可 以 快 
速 定 位 到 网 页 中 的 一 个 或 者 一 组 元 素 。 


13.1.3 ”VBA 开发 网 页 自动 化 的 优势 


微软 公司 提供 了 浏览 器 对 象 (WebBrowser、Intemet Explorer) 接口 和 发 送 HITP 请 求 的 
对 象 (XMLHTTP、WinHttp 等 ) 接口 。 这 些 接口 可 以 被 微软 公司 的 很 多 种 编程 语言 调用 ， 例 
如 Office VBA、VB6、Net 语言 。 

虽然 其 他 编程 语言 也 能 实现 网 页 自动 化 和 网 页 抓 取 ,但 门槛 相对 较 高 ， 开 发 出 的 自动 化 
产品 部 署 复杂 。 
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使 用 VBA 进行 网 页 自动 化 的 开发 ， 只 需要 VBA 开发 环境 和 浏览 器 就 够 了 ， 因 此 具备 
开发 成 本 低 、 兼 容 性 好 、 产 品 的 分 发 部 署 简单 等 很 多 优点 。 


13.1.4 ”本 章 主 要 内 容 


本 章 总 体 上 分 为 三 大 部 分 : 认识 HTML 文档 、 自 动 操作 浏览 器 和 网 页 、 自 动 发 送 HTTP 
请 求 ， 如 表 13-1 所 示 。 


表 13-1 本 章 内 容 框架 
HTML 基础 
网 页 的 构成 、 元 素 之 间 的 关系 、 元 素 的 属性 
HTML DOM 对 象 模型 
使 用 GetElement 方面 的 方法 获取 元 素 、 自 动 填写 并 提交 表单 


浏览 器 的 自动 操作 HTTP 请 求 的 发 送 和 响应 
使 用 浏览 器 的 开发 工具 查找 元 素 使 用 浏览 器 的 开发 工具 录制 请 求 过 程 
自动 输入 内 容 、 单 击 按钮 和 超 链接 请 求 头 和 请 求 体 、 响 应 头 和 响应 消息 


JIntemet Explorer 
独立 的 网 页 


WebBrowser 
bs ties, XMLHTTP 


共同 内 容 : 延 时 等 待 、 文 件 下 载 、url 的 编码 和 解码 


其 中 Internet Explorer 和 WebBrowser 的 Document 属性 可 以 直接 转换 为 一 个 HIML 
Document， 而 由 XMLHTTP、WinHttp 得 到 的 ResponseBody、ResponseText 作为 字符 串 也 可 
以 产生 一 个 HIMLDocument。 

其 中 ，HIMLDocument 方 面 的 重点 和 难点 是 网 页 元 素 的 定位 方法 ， 识 别 网 页 元 素 的 类 
型 ， 调 用 网 页 元 素 的 方法 。 

XMLHITP 和 WinHttp 的 应 用 方面 主要 内 容 包括 网 页 源 代 码 的 获取 ， 使 用 SetRequestHeader 
设置 请 求 头 、 请 求 体 的 构造 和 发 送 、 编 码 和 解码 、 使 用 getAlIResponseHeaders 和 getResponseHeader() 
获取 响应 头等 内 容 。 


13.2 HTML 基础 


HTML 指 的 是 超 文本 标记 语言 (Hyper Text Markup Language)， 使 用 标记 标签 来 描述 
网 页 。 

标记 标签 ， 也 可 以 称 为 元 素 ( Element)。 与 XML 中 的 元 素 非常 类 似 ，HTML 中 的 元 素 
表示 如 下 。 

< 元 素 名 称 属性 名 称 1= 属性 值 1> 文本 </ 元 素 名 称 > 

大 体 来 看 ， 元 素 的 定义 可 以 分 为 三 部 分 。 

口 元 素 的 开始 标签 ， 以 <> 括 起 来 ， 如 果 有 其 他 属性 ， 也 要 写 在 开始 标签 的 内 部 。 

口 元 素 的 文本 ， 夹 在 开始 标签 和 结束 标签 之 间 。 
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口 元 素 的 结束 标签 ， 以 </> 表示 ， 结 束 标签 中 的 元 素 名 称 必须 与 开始 标签 中 的 元 素 名 称 
相同 。 

一 个 元 素 的 代码 也 可 以 写作 多 行 。 

当 一 个 元 素 不 包含 任何 子 元 素 、 文 本 时 ， 可 以 不 写 结束 标签 。 形 式 如 下 。 

< 元 素 名 称 属性 名 称 1= 属性 值 1/> 


注意 ， 后 面 的 左 尖 括 号 前 面 有 一 个 斜 枉 ， 表 示 这 个 元 素 的 代码 到 此 为 止 。 
HTML 中 ， 元 素 和 元 素 之 间 的 基本 关系 是 父子 关系 与 兄弟 关系 。 
一 个 网 页 的 主要 元 素 框架 形式 如 下 。 
<html> 
<head> 
<meta charset="utf-8"/> 
<title> 网 页 标题 </title> 
</head> 
<body> 
主体 内 容 
</body> 
</html> 


以 上 代码 可 以 用 记事 本 程序 编辑 并 保存 为 扩展 名 为 .html 的 网 页 文件 。 

一 个 HTML 文档 的 根 元 素 是 html， 下 面包 含 head 和 body 两 个 子 元 素 ， 其 中 head 用 来 
指定 网 页 的 编码 、 标 题 等 信息 ，body 是 网 页 的 主体 部 分 。 

下 面 介绍 body 元 素 下 面 最 常用 的 网 页 元 素 的 写法 。 


13.2.1 标题 


这 里 所 说 的 标题 类 似 于 Word 中 的 表示 章节 的 大 纲 标题 。HITML 中 使 用 <hl> ~ <h6> 表 
示 1 ~ 6 级 标题 。 

以 下 代码 定义 了 一 个 1 级 标题 ， 这 个 元 素 的 名 称 是 hl, 属性 名 称 是 style， 属 性 值 是 
colorred， 该 元 素 的 内 容 是 “ 刘 白 梦 的 简历 ”。 


<hl style="color:red"> 刘 白 梦 的 简历 </h1> 
13.2.2 注释 


HTML 中 注释 的 写法 如 下 : 
<! 一 注释 内 容 --> 
被 注释 的 部 分 不 起 任何 作用 ， 在 网 页 中 看 不 到 注释 的 内 容 。 


13.2.3 表格 


HIML 中 ,使 用 table 定义 一 个 表格 。 
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table 元 素 的 子 元 素 为 t， 每 个 tt 元素 表示 表格 的 一 行 ，tr 元 素 下 面包 含 多 个 td 元 素 。 
每 个 td 元 素 表示 该 行 的 一 个 单元 格 。 


<table border="1"> 
<tr><td> 姓名 </td><td> 刘 白 梦 </td><td> 性 别 </td><td> 女 </td></tr> 
<tr><td> 年 龄 </td><td>25</td><td> 民族 </td><td> 汉族 </td></tr> 
<tr><td> 毕业 院 校 </td><td> 化 工大 学 </td><td> 专业 </td><td> 化 学 工程 </td></tr> 


</table> 
以 上 HTML 代码 中 ，border="1" 表示 这 个 表格 显示 边框 线 ， 还 可 以 看 出 该 表格 有 3 行 ， 
每 行 有 4 列 。 


以 上 代码 显示 在 网 页 中 的 效果 如 图 13-1 所 示 。 pr EE 医 天 |EE 洒 人 
因此 ，HTML 表格 的 三 层 递 进 元 素 依次 为 table tr ”| 医 龄 ”|]b5 民 计 | 汉族 


和 td。 附 业 院 横 | 化工 大 学 | 传 业 | 化学 工程 
如 果 要 把 表格 的 首 行 显示 为 标题 行 ， 有 时 候 还 用 也 代 图 13-1 HTML 表格 
替 td。 


<table border="1"> 
<tr><th> 语言 </th><th> 程度 </th><th> 使 用 时 长 </th></tr> 
<tr><td>Excel VBA</td><td> 熟练 </td><td>5 年 </td></tr> 
<tr><td>VB6</td><td> 熟练 </td><td>2 年 </td></tr> 
<tr><td>Python</td><td> 入 门 </td><td>1l 年 </td></tr> 
</table> 


以 上 HTML 在 网 页 中 的 显示 效果 如 图 13-2 所 示 。 图 13-2 使 用 标题 行 的 表格 


13.2.4 图 像 


HTML 使 用 img 定义 一 个 图 像 ，img 元 素 最 重要 的 属性 是 src， 用 来 指定 所 指向 的 图 像 
文件 地 址 。 
以 下 代码 表示 在 此 处 显示 一 幅 图 ， 图 片 的 地 址 是 photojpg， 这 是 一 个 相对 路 径 。 


<img src="'photo.jpg'/> 


13.2.5” 超 链接 


HTML 中 使 用 a 定义 一 个 超 链 接 ，href 属性 指定 单 击 该 超 链接 后 跳 人 的 地 方 。a 元素 的 
文本 内 容 是 显示 在 网 页 上 的 内 容 。 


<a href="https://home.cnblogs.com/u/ryueifu-VBA/"> 个 人 主页 </a> 


上 述 代码 在 网 页 中 产生 的 效果 如 图 13-3 所 示 。 

通常 情况 下 ， 一 个 网 页 中 的 超 链接 非常 多 。 这 里 产生 一 个 问题 ， 当 用 
户 单 击 了 某 个 超 链接 ， 是 在 原 有 页 面 中 打开 超 链接 ， 还 是 在 新 窗口 中 打开 ”| 个 人 主页 
超 链接 ? 这 取决 于 target 属性 。 图 13-3” 超 链接 
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例如 target="_blank"， 表 示 超 链接 被 单 击 后 ， 在 新 窗口 中 打开 超 链 接 的 页 面 。 
target="_self"， 表 示 超 链接 被 单 击 后 ， 在 原 窗口 中 打开 超 链接 的 页 面 。 


13.2.6 ”列表 


HTML 的 列表 类 似 于 Word、PowerPoint 中 的 项 目 符号 和 列表 。 
无 序列 表 用 也 定义 , 使 用 i 表示 具体 的 条 目 。 
<ul> 


<1i> 英语 </1i> 
<1iy> 日 语 </1i> 


</ul> 
以 上 代码 定义 了 一 个 无 序列 表 ， 显 示 效 果 如 图 13-4 所 示 。 - 英语 
有 序列 表 用 ol 定义 。 
图 13-4 无 序列 表 
<ol> 


<li class="Chemical"> 北京 化 工厂 - 研发 助理 </1i> 

<li class="Chemical"> 北京 化 学 品 公司 - 高 级 研发 工程 师 </1i> 

<li class="Programming"> 北京 广告 公司 - 编程 开发 岗位 </1i> 
</ol> 


以 上 代码 的 显示 效果 如 图 13-5 所 示 。 


1. 北京 化 工厂 -研发 助理 
2. 北京 化 学 品 公司 -高 级 研发 工程 师 
3. 北京 广告 公司 -编程 开发 岗位 


图 13-5 有 序列 表 


13.2.7 ”表单 控件 


表单 是 允许 用 户 在 网 页 中 进行 交互 的 内 容 ， 例 如 在 网 页 中 提供 文本 框 、 按 钮 等 。 
HTML 中 使 用 form 定义 一 个 表单 ， 里 面 可 以 定义 多 个 控件 ， 表 单 控件 统一 使 用 input 
来 定义 。 职位 搜索 
下 面 的 代码 在 表单 中 定义 了 2 个 文本 框 ， 用 于 接收 用 户 | 职位 名 称 :REA 
输入 的 文本 ， 最 后 定义 了 一 个 按钮 。 显 示 效 果 如 图 13-6 所 示 。 。 | 期 望 某 资 : |8800 


搜索 
<form> 
职位 名 称 : <input id="Keyword" name="InputField" 图 13-6 表单 
type="text" value="VBA" /> 
hr. /> 
期 望 薪资 : <input id="salary" name="InputField" type="text" value="8800" /> 
<br /> 
<button id="Search"” name="Buttonl" onclick="alert(' 正在 搜索 ,请 稍 候 . . . ') "> 搜 


索 </button> 
</form> 
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13.3 HTML DOM 对 象 模型 


HTML DOM 定义 了 所 有 HTML 元 素 的 对 象 和 属性 ， 以 及 访问 它们 的 方法 。 换 言 之 
HTML DOM 是 关于 如 何 获取 、 修 改 、 添 加 或 删除 HIML 元 素 的 标准 。 

在 VBA 中 ， 向 工程 中 添加 “Microsoft HTML Object Library” 的 引用 ， 就 可 以 使 用 
HTML DOM 对 象 库 中 的 对 象 类 型 、 属 性 、 方 法 等 ， 如 图 13-7 所 示 。 


引用 - VBAProject >| 


可 使 用 的 引用 0) [| 


Visual Basic For Applications 
MMicrosoft Excel 15.0 Object Librar 
MOLE Autonation | 
Microsoft Office 15.0 Object Libra 浏览 8). 
加 


HE Forms 2.0 Object Library + 
优先 级 
+ 


JMicrosoft Internet Controls 

J Microsoft XL, v6.0 

Microsoft ActiveX Data Objects 2.8 
Microsoft Seripting Runtime 
Microsoft VBSeript Regular Express 
DMicrosoft Visual Basic for Applica 
DM erosoft WinMTTP Services, versio = 


Microsoft HIML Object Library 
定位 C:\Windows\Systen32\mshtnl. tlb 
语言 本; 


L | 
图 13-7 添加 外 部 引用 

一 个 网 页 的 源 代码 可 以 被 看 作 一 个 很 长 的 字符 串 ， 如 果 用 VBA 的 字符 串 处 理 函数 ,或 
者 正则 表达 式 来 操作 和 访问 HTML 代码 中 的 元 素 ， 则 非常 费事 。 

虽然 HTML 代码 错综复杂 ， 包 含 各 式 各 样 的 元 素 , 但 还 是 有 规律 可 循 的 ， 任 何 一 个 元 
素 都 不 是 孤立 存在 的 ，HTML 文档 可 以 被 看 作 一 个 由 父子 元 素 节 点 、 兄 弟 元 素 节点 连接 而 成 
的 文档 树 。 

HTML DOM 对 象 模型 中 ， 把 一 个 网 页 的 所 有 内 容 形 成 的 文档 定义 为 HIMLDocument 
对 象 ， 这 个 文档 的 根 元 素 节点 就 是 html 节点 。head 和 body 都 是 html 节点 的 子 节点 。 


13.3.1 使 用 HTML DOM 创建 网 页 
VBA 工 程 中 加 入 了 “Microsoft HTML Object Library” 这 个 外 部 引用 之 后 ， 在 声明 
HIML DOM 相关 变量 的 时 候 ， 输 入 MSHTML. 就 可 以 看 到 所 有 对 象 类 型 名 称 。 常 用 网 页 元 
素 的 对 象 类 型 ， 如 表 13-2 所 示 。 
表 13-2 ”常用 网 页 元 素 的 对 象 类 型 


HTML DOM 对 象 类 型 


<html> MSHTML.HITMLHtmlElement 网 页 的 根 节点 
<head> | MSHTML HTMLHeadElement 网 页 的 头 剖 


网 页 的 标题 
网 页 的 主体 


<title> MSHTML.HTMLTitleElement 
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续 表 

节点 名 称 HTML DOM 对 象 类 型 描 述 
<a> MSHTML.HTMLAnchorElement 超 链接 
<br/> MSHTML.HTMLBRElement 换行 符 
<caption> MSHTML.HTMLTableCaption 表格 的 标题 
<frame> MSHTML.HTMLFrameElement frame 框架 
<hl> 到 <h6> MSHTML.HTMLHeaderElement 标题 
<iframe> MSHTML.HTMLIFrame iframe 内 联 框架 
a Tn 

MSHTML.HTMLInputElement 输入 控件 
J 输入 

表单 中 的 文件 选择 对 话 杠 

i A 
二 FRR 
二 i 
ior 7 
~ 
a a 
oy RM 
a ET 
<tr> MSHTML.HTMLTableRow 表格 的 行 


一 般 情况 下 ， 编辑、 创建 网 页 是 使 用 专业 的 网 页 编辑 软件 ， 手 工 书写 而 成 。 在 VBA 
中 ， 可 以 创建 HTMLDocument， 并 且 逐 级 插入 必要 的 元 素 , 设置 其 相关 属性 ， 即 可 形成 一 
个 完整 的 网 页 。 

使 用 New 关键 字 创建 一 个 新 的 HIML 文档 ， 此 时 该 文档 自动 具备 了 基本 框架 (html、 
head 、body 不 需要 创建 节点 )。 因 此 ， 只 需要 在 Body 节点 下 面 创建 元 素 即 可 。 

例如 ， 要 在 Body 中 创建 如 下 的 超 链 接 元 素 。 


<A href="https://home.cnblogs.com/u/ryueifu-VBA/"> 刘 白 梦 的 个 人 主页 </R> 


对 应 的 VBA 代码 如 下 。 
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Dim a As MSHTML .HTMLAnchorElement 

Set a = HDoc.createElement ("a") 

a.setAttribute strAttributeName:="href", AttributeValue:="https://home.cnblogs. 
com/u/ryueifu-VBA/" 

a.innerText = " 刘 白 梦 的 个 人 主页 " 

body.appendChild a ' 把 a 附加 到 Body 之 下 


上 述 代码 的 含义 是 ， 首 先 声 明 一 个 超 链接 元 素 ， 然 后 使 用 HTML 文档 创建 一 个 a 元 素 ， 
设置 a 元 素 的 href 属性， 并 日 设 置 a 元 素 的 文本 内 容 ， 最 后 把 a 元 素 附 加 到 Body 中 。 

照 着 如 上 的 逻辑 和 方法 ， 就 可 以 为 HTML 文档 中 加 入 各 种 类 型 的 元 素 节点 。 

下 面 的 程序 自动 创建 一 个 HTML 文档 ， 并 另存 为 本 地 网 页 文件 。 


Sub 自动 创建 网 页 () 
Dim HDoc As MSHTML .HTMLDocument 
Set HDoc = New MSHTML .HTMLDocument 
Dim Body Rs MSHTML .HTMLBody 
Set Body = HDoc.Body 


Dim hl As MSHTML.HTMLHeaderElement 

Set hl = HDoc.createElement ("h1") 

hl.innerText = " 刘 白 梦 的 简历 " 

Body.appendChild newChild:=hl ' 把 hl 元 素 附加 到 Body 中 


Dim table As MSHTML .HTMLTable 

Dim tr Rs MSHTML.HTMLTableRow 

Dim td Rs MSHTML.HTMLTableCol 

Set table = HDoc.createElement ("table") 
table.setAttribute strAttributeName:="border", AttributeValue:="]1" 
Set tr = HDoc.createElement ("tr") 

Set td = HDoc.createElement ("td") 
td.innerText = "姓名 " 

tr.appendchild td 

Set td = HDoc.createElement ("td") 
td.innerText = "年 龄 " 

tr.appendchild td 

table.appendChild tr 

Set tr = HDoc.createElement ("tr") 

Set td = HDoc.createElement ("td") 
td.innerText = " 刘 白 梦 " 

tr.appendchild td 

Set td = HDoc.createElement ("td") 
td.innerText = "25" 

tr.appendchild td 

table.appendChild tr 

Body.appendchild table ' 把 table 附加 到 Body 中 


Dim img As MSHTML .HTMLImg 

Set img = HDoc.createElement ("img") 
img.setAttribute strAttributeName: 
img.setAttribute strAttributeName "width", AttributeValue:=100 
img.setAttribute strAttributeName:="height", AttributeValue:=120 
Body.appendchild img “把 img 附加 到 Body 中 


"src", AttributeValue:="Photo.jpg" 


Dim p As MSHTML.HTMLParaElement 
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Set p = HDoc.createElement ("p") 
Body.appendchild p ' 插入 一 个 空 段落 


Dim a As MSHTML.HTMLANnchorElement 

Set a = HDoc.createElement ("a") 

a.setAttribute strAttributeName:="href", AttributeValue:="https://home.cnblogs. 
com/u/ryueifu-VBA/™ 

a.innerText = " 刘 和 白 梦 的 个 人 主页 " 

Body.appendchild a ' 把 a 附加 到 Body 中 


Dim form Rs MSHTML.HTMLFormElement 

Set form = HDoc.createElement ("form") 

Dim text As MSHTML.HTMLINnputTextElement 

Set text = HDoc.createElement ("input") 

text.setAttribute strAttributeName:="id", AttributeValue:="Keyword" 
text.setAttribute strAttributeName: ype", AttributeValue:="text" 
text.setAttribute strAttributeName:="value", AttributeValue 
form.appendChild text 

Dim button As MSHTML.HTMLINnputButtonElement 

Set button = HDoc.createElement ("input") 
button.setAttribute strAttributeName:="id", AttributeValue:="Search" 
button.setAttribute strAttributeName:="type", AttributeValue:="button" 
button.setAttribute strRttributeName:="value"，RttributeValue:=" 搜索 " 
form.appendChild button 

Body.appendCchild form ' 把 form 附加 到 Body 中 


Open ThisWorkbook.Path & "\WebPagel.html" For Output Rs #1' 保存 为 网 页 文件 
Print #1, HDoc.DocumentElement.outerHTML 
Close #1 
End Sub 


运行 上 述 程序 ， 会 在 工作 短 所 在 路 径 生 成 WebPagel.html， 使 用 记事 本 查看 内 容 ， 如 
图 13-8 所 示 。 


<P)&nbsp;</P> 
< 二; 测 间 梦 的 简历 /ly 
TABLE border=1> 


<TD> 姓 名 </TD> 
<TD> 年 齿 </TD> 
《ATR> 


<《TR> 
《TD 刘 白 梦 </TD> 
《TD>25</TD> 


</TR> 
/TABLE>CING src="Photo. jpg” width=100 height=120> 
<P> 
</P> 
<A href=“https://home. cnblogs. com/u/ryueifu-VBA/”> 刘 白 梦 的 个 人 主页 《</A> 
<FORN> 


《INPUT id-Keyword value=VBA> 
《INPUT id-Search type=button value= 搜 索 > 
</FORN> 
</BODY> 
</HTNL> 


图 13-8 使 用 VBA 自动 创建 网 页 
在 正 浏览 器 中 查看 该 网 页 ， 效果 如 图 13-9 所 示 。 
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加 三 要 下 
[人 ex VBA 开 发 和 关中 退 阶 郑源 代 到 \ 网 页 生动 {CWebPagelhtml Pre 


文件 (日 ” 编 加 (E) 查看 V) 收藏 夫 (A) 工具 (T) 帮 动 (H) 


刘 白 梦 的 简历 


隆 名 | 降 花 
网 日 所 25 


于 


+ 
刘 白 梦 的 个 人 主页 
区 ] 


图 13-9 在 浏览 器 中 打开 网 页 
以 上 程序 的 源 代码 文件 为 “实例 文档 82.xlsm”。 


13.3.2 ”使 用 HTML DOM 解析 网 页 内 容 


无 论 一 个 网 页 的 内 容 有 多 复杂 ， 其 根源 都 是 HTML 源 代码 ， 是 一 个 很 长 的 字符 串 。 那 
么 里 面 究 竟 包 含 了 哪些 元 素 ， 每 个 元 素 有 哪些 属性 呢 ? 

显然 ,用 传统 的 字符 串 处 理 方式 是 不 妥 的 。 使 用 HIML DOM 可 以 轻松 获取 HIML 文 
档 的 方方面面 。 

位 于 计算 机 磁盘 上 的 网 页 文件 可 以 利用 文本 文件 读 取 的 方式 读 取 网 页 代码 ， 赋 给 
HTMLDocument 对 象 ， 而 对 于 网 络 上 的 外 部 网 页 ， 在 联网 的 情况 下 可 以 使 用 XMLHttp 对 象 
获取 网 页 源 代码 。 

在 工作 短路 径 下 有 一 个 事先 做 好 的 网 页 “ 刘 白 梦 的 简历 .html"， 下 面 的 程序 采用 
XMLHttp 方式 获取 网 页 内 容 。 

Sub 形成 HTML 文档 () 


Dim X As MSXML2 .XMLHTTP60，HDoc As MSHTML.HTMLDocument 
Set X = New MSXML2 .XMLHTTP60 


With X 
.Open "GET"，ThisWorkbook.Path & "\ 刘 白 梦 的 简历 .html"，False 
.send 
Do Until .readyState = 4 
DoEvents 
Loop 


Set HDoc = New MSHTML.HTMLDocument 

HDoc.body.innerHTML = .responseText ' 把 网 页 源 代 码 赋 给 HDoc， 形 成 DOM 
Debug.Print HDoc.DocumentElement .outerHTML 

" 主要 骨架 元 素 

Dim Root Rs MSHTML.HTMLHtmlElement '<html>...</html> 元 素 

Dim Head Rs MSHTML.HTMLHeadElement '<head>. . .</head> 元 素 

Dim Body Rs MSHTML.HTMLBody '<body>. . -</body> 元 素 

Set Root = HDoc.DocumentElement 

Set Head = HDoc.Head 
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Set Body = HDoc.Body 

Debug.Print Root.nodeName 
Debug.Print Head.nodeName 
Debug.Print Body.nodeName 


End With 

End Sub 

和 运行 上 述 程序 ， 立 即 窗口 打印 出 如 下 网 页 源 代 码 (为 便于 讲解 ， 行 首 添加 了 行 号 ): 

1. <html> 

2 <head> 

ke <meta charset="utf-8"/> 

机 <title> 刘 白 梦 的 简历 </title> 

5 </head> 

G6» <body> 

Tm <!--1 级 标题 --> 

8. <hl style="color:red"> 刘 白 梦 的 简历 </h1> 

9. <!--2 级 标题 --> 

IO <h2> 认真 负责 、 实 事 求 是 ! </h2> 

is <!-- 段落 --> 

2。 <p> 基本 信息 </p> 

3% <!-- 表格 --> 

14. <table border="1"> 

和 <tr><td> 姓名 </td><td> 刘 白 梦 </td><td> 性 别 </td><td> 女 </td></tr> 

6 <tr><td> 年 龄 </td><td>25</td><td> 民族 </td><td> 汉族 </td></tr> 

Ws <tr><td> 毕业 院 校 </td><td> 化 工大 学 </td><td> 专业 </td><td> 化 学 工程 

</td></tr> 

16, </table> 

19. <!-- 图 像 --> 

20. <p> 近 照 </p> 

2 <img src='photo.jpg'/> 

2 <!-- 无 序列 表 --> 

2 和 <p> 外 语 水 平 </p> 

24. <ul> 

255 <1i> 英语 </1i> 

26. <1iy> 日 语 </1i> 

2 </ul> 

28. <!-- 有 序列 表 --> 

29. <p> 工作 经 验 </p> 

30. <ol> 

E> <li class="Chemical"> 北京 化 工厂 - 研发 助理 </1i> 

3 <li class="Chemical"> 北京 化 学 品 公司 - 高 级 研发 工程 师 </1i> 

类 六 <li class="Programming"> 北京 广告 公司 - 编程 开发 岗位 </1i> 

34. </ol1> 

35. <p> 计算 机 语言 </p> 

6 <table border="1"> 

37x <tr><th> 语言 </th><th> 程度 </th><th> 使 用 时 长 </th></tr> 

38. <tr><td>Excel VBA</td><td> 熟练 </td><td>5 年 </td></tr> 

39. <tr><td>VB6</td><td> 熟练 </td><td>2 年 </td></tr> 

40. <tr><td>Python</td><td> 入 门 </td><td>l 年 </td></tr> 

41 . </table> 

二。 <br/> 

43 . <!-- 超 链接 --> 

44. <a href="https://home.cnblogs.com/u/ryueifu-VBA/" target=" blank"> 
个 人 主页 </a> 


45. <br/> 
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46. <!-- 表单 --> 

47. <p> 职位 搜索 </p> 

48. <form> 

49. 职位 名 称 : <input id="Keyword" name="InputField" type="text" 
value="VBA" /> 

S50 <br /> 

Se 期 望 薪资 : <input id="Salary" name="InputField" type="text" 
value="8800" /> 

52. <br /> 

53. <button id="Search" name="Buttonl" onclick="alert(' 正在 搜索 ,请 稍 
候 ...')"> 搜 索 </button> 

Ss </form> 

Ss </body> 

56. </html> 

接 下 来 介绍 一 下 HTML 文档 中 的 主要 对 象 和 管辖 范围 。 

任何 一 个 HTML 文档 有 且 只 有 一 个 <html> 根 节点 ， 该 节点 下 面包 含 <head> 和 <body> 

两 个 子 节点 ， 而 网 页 中 大 多 数 的 元 素 都 是 <body> 节点 的 后 代 节点 。 


以 上 三 个 骨架 对 象 的 声明 和 赋值 方法 如 下 。 


Dim Root As MSHTML.HTMLHtmlElement '<html>...</html> 元 素 
Dim Head As MSHTML.HTMLHeadElement '<head>...</head> 元 素 
Dim Body As MSHTML.HTMLBody '<body>...</body> 元 素 

Set Root = HDoc.DocumentElement 

Set Head HDoc.Head 

Set Body HDoc .Body 


其 中 ，HDoc 是 一 个 HTML 文档 对 象 。 

如 果 以 上 面 的 网 页 源 代码 为 例 ， 那 么 Root 对 象 的 范围 是 第 1 ~ 56 行 ，Head 对 象 的 范 
围 是 第 2 ~ 5 行 ，Body 对 象 的 范围 是 第 6 ~ 55 行 。 

打印 它们 的 OuterHTML 属性 ， 就 可 以 了 解 各 自 的 范围 。 


13.3.3 ”获取 和 定位 网 页 元 素 


如 前 面 所 述 ， 获 取 文档 中 的 元 素 ， 其实 就 是 获取 <body> 节点 下 面 的 各 个 元 素 的 过 程 。 
获取 和 定位 网 页 元 素 的 意义 是 : 一 旦 获取 一 个 元 素 ， 就 可 以 对 其 进行 读 取 和 更 改 。 由 于 所 
有 元 素 都 位 于 HTML 文档 的 树 形 结构 中 ,， 因 此， 理论 上 说 ， 可 以 定位 到 文档 中 的 任意 一 个 
元 素 。 

获取 和 定位 元 素 的 方法 主要 分 为 以 下 两 个 体系 。 

1. 根据 元 素 的 相对 位 置 关系 

口 alltags: 返回 当前 节点 中 包含 的 指定 名 称 的 后 代 节点 集合 。 

口 ParentNode: 返回 当前 节点 的 父 节 点 。 

口 ChildNodes: 返回 当前 节点 包含 的 所 有 子 节点 集合 。 

口 FirstChild: 返回 当前 节点 的 首 个 子 节点 。 

口 PreviousSlibing: 返回 当前 节点 的 前 一 个 同 级 节点 。 
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口 NextSlibing: 返回 当前 节点 的 后 一 个 同 级 节点 。 

下 面 的 程序 还 是 以 读 取 “ 刘 白 梦 的 简历 .html” 文 件 为 例 ， 程 序 的 思路 是 获取 所 有 表格 ， 
然后 以 第 2 个 表格 (对 应 于 网 页 源 代码 中 的 第 36 ~ 41 行 ) 为 中 心 对 象 ， 分别 获取 该 对 象 的 
上 级 、 下 级 、 同 级 兄弟 的 各 个 对 象 ， 打 印 每 个 对 象 的 节点 名 称 。 

Sub 根据 相对 位 置 定位 元 素 () 


Dim HDoc As MSHTML .HTMLDocument 
Dim tables As MSHTML.IHTMLElementCollection 
Dim table As MSHTML.HTMLTable 

' 获取 网 页 源 代 码 并 赋 给 HDoc 的 代码 略 
Set tables = HDoc.all.tags("table") ' 文档 中 的 所 有 table 
Set table = tables.Item(1) ' 第 2 个 table 
Debug.Print " 父 节 点 : "，table.ParentNode .nodeName 
Debug.Print "第 1 个 子 节点 : "，table.ChildNodes (0) .nodeName 
Debug.Print "第 1 个 子 节 点 : "，table.FirstChild.nodeName 
Debug.Print " 前 一 个 兄 节 点 : "，table.PreviousSibling.nodeName 
Debug.Print " 后 一 个 兄 节点 : "，table.NextSibling.nodeName 


End Sub 
立即 窗口 中 的 打印 结果 如 下 。 
父 节点 : BODY 


第 1 个 子 节点 : TBODY 

第 1 个 子 节点 : TBODY 

前 一 个 兄 节点 :了 

后 一 个 兄 节点 : ”BR 

2. 根据 元 素 自身 的 名 称 和 属性 

HIML DOM 提供 了 如 下 4 个 常用 的 获取 当前 节点 的 后 代 节 点 的 方法 。 

口 getElementById: 根据 指定 的 id 属性 获取 对 应 的 元 素 ， 由 于 一 个 网 页 中 不 允许 使 用 重 
复 的 i4， 因 此 该 方法 返回 的 是 唯一 的 元 素 。 

口 getElementsByClassName: 根据 指定 的 class 属性 ， 返 回 一 个 元 素 集合 。 

口 getElementsByName: 根据 指定 的 name 属性 ， 返 回 一 个 元 素 集合 。 

口 getElementsByTagName: 根据 指定 的 元 素 名 称 ， 返 回 一 个 元 素 集合 。 

假设 一 个 网 页 的 <body> 节点 中 有 如 下 表单 。 


<form> 
<input id="Keyword" name="InputField" type="text" value="VBA" /> 
<br /> 
<input id="Salary" name="InputField" type="text" value="8800" /> 
<br /> 
<button id="Search"” name="Buttonl"> 搜索 </button> 

</form> 


可 以 看 出 表单 中 包含 两 个 input 元 素 和 一 个 button 元 素 。 其 中 第 2 个 input 元素 的 id 是 
Salary，name 是 InputField，TagName 是 input。 
下 面 的 程序 利用 元 素 自身 属性 通过 多 种 方式 定位 第 2 个 input 元 素 。 
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Sub 根据 自身 属性 定位 元 素 () 
Dim HDoc As MSHTML.HTMLDocument 
Dim Col As MSHTML.IHTMLElementCollection 
Dim body As MSHTML .HTMLBody 
Dim form As MSHTML.HTMLFoOrmElement 
Dim textbox Rs MSHTML.HTMLINnputTextElement 
" 获取 网 页 源 代 码 并 赋 给 HDoc 的 代码 略 
Set body = HDoc.body 
Set form = HDoc.forms.Item(0) 'HTML 文档 中 的 首 个 表单 
Set textbox = HDoc.getElementById(v:="Salary") 
Set textbox = HDoc.getElementsByName (V:="InputField") .Item(1) " 第 2 个 input 
Set textbox = body.getElementsByTagName (Vv:="input") .Item(1) ' 第 2 个 input 
Set textbox = form.getElementsByTagName (Vv:="input") .Item(1) ' 第 2 个 input 
' 以 下 遍历 每 个 名 称 为 InputField 的 元 素 
Set Col = HDoc.getElementsByName ("InputField") 
For Each textbox In Col 
Debug.Print textbox.getAttribute ("value") 
Next textbox 
End Sub 


代码 分 析 : 使 用 以 getElements 开头 的 方法 获取 的 是 元 素 集 合 (类 型 是 IHTML 
ElementCollection ) 。 

上 述 代 码 中 连续 4 行 以 Set textbox = 开头 的 代码 均 指 向 同一 个 对 象 。 

以 上 程序 的 源 代码 文件 为 “实例 文档 83.xlsm”。 


13.3.4 innerHTML、outerHTML、innerText、outerText 的 区 别 


网 页 元 素 有 innerHTML 、outerHTML 、innerText、onuterText 4 个 属性 ， 其 中 以 HTML 
结尾 的 属性 用 于 设置 或 返回 元 素 的 包含 标签 的 网 页 代码 ， 以 Text 结尾 的 属性 是 不 含 标签 的 
文本 。 

inner 是 内 部 ，outer 是 外 部 。 例 如 ， 下 面 这 个 超 链接 元 素 的 内 部 包含 一 个 hl 标签 。 


<a id="Blogl" href="https://home.cnblogs.com/u/ryueifu-VBA/"><hl1 style= 
"color:red"> 刘 永 富 的 博客 </h1></a> 


因此 ， 这 个 超 链接 的 outerHTML 是 上 述 全 部 HIML 代码 ，innerHTML 是 夹 在 a 标签 开 
始 标签 与 结束 标签 之 间 的 部 分 ， 也 就 是 代码 加 粗 的 部 分 。 
超 链接 元 素 的 innerText、outerText 都 是 “ 刘 永 富 的 博客 ”。 


13.3.5 ”使 用 InsertAdjacent 系列 方法 插入 元 素 


HTML DOM 中 的 网 页 元 素 有 一 些 以 InsertAdjacent 开头 的 方法 名 称 。 
口 InsertAdjacentElement: 在 指定 位 置 插入 新 元 素 。 

口 msertAdjacentHTML: 在 指定 位 置 插入 HIML 代码 。 

口 msertAdjacentText: 在 指定 位 置 插入 文本 内 容 。 
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以 上 3 个 方法 都 有 一 个 必须 规定 的 where 参数 ， 该 参数 的 取 值 可 以 是 以 下 4 个 字符 串 


常量 。 
口 "BeforeBegin": 当前 元 素 的 开始 标签 之 前 。 
口 "AfterBegin": 当前 元 素 的 开始 标签 之 后 。 
口 "BeforeEnd": 当前 元 素 的 结束 标签 之 前 。 
口 "AfterEnd": 当前 元 素 的 结束 标签 之 后 。 
以 下 面 的 超 链接 元 素 为 例 : 


<a id="cnblogs" href="https://www.cnblogs.com/"” target=" blank"> 博客 园 </a> 


第 1 个 < 的 前 面 用 "BeforeBegin" 表示 。 
第 1 个 > 的 后 面 用 "AfterBegin" 表示 。 
第 2 个 < 的 前 面 用 "BeforeEnd" 表示 。 
第 2 个 > 的 后 面 用 "AfterEnd" 表示 


假设 单元 格 B2 中 存储 了 一 些 HTML 代码 ， 可 以 看 出 ,一 个 div 下面 包含 了 两 个 a 元 


素 ， 如 图 13-10 所 示 。 


B2 > 天 <dvid='dvl> 
让 A 
2 
idu" href="https://www.baidu.com/" target=" blank"> 百 度 </a> 
<a id="cnblogs" href="https://www.cnblogs.com/" target=" blank"> 博 客 园 </a> 
</div> 
3 运行 后 的 效果 


<DIV id=div1> 
<A id=baidu href="https://www.baidu.com/" target=_blank> 百 度 </A> 
<A href="https://edu.51cto.com/" target=_blank>51CTO 学 院 </A> 
<A id=cnblogs href="https://www.cnblogs.com/" target=_blank><IMG 
src="https://www.cnblogs.com/images/logo_small.gif'> 博 客 园 首页 </A> 
<P> 此 处 换行 </P> 
</DIV> 


图 13-10 单元 格 B2 中 的 HTML 代码 


下 面 的 程序 以 cnblogs 元 素 为 当前 元 素 ， 依 次 使 用 InsertAdjacent 系列 的 方法 ， 在 该 
素 的 前 后 插入 一 些 元 素 和 文本 。 运 行 该 程序 ， 修 改 后 的 网 页 代码 显示 于 单元 格 B4 中 。 


Sub 使 用 InsertAdjacent 系列 方法 () 
Dim HDoc As MSHTML .HTMLDocument 
Set HDoc = New MSHTML .HTMLDocument 
HDoc.body.innerHTML = Range("B2") .Value " 形成 HTML 文档 
Dim divl As MSHTML.HTMLDivElement 
Set divl = HDoc.getElementById ("divl1") 
Dim cnblogs As MSHTML.HTMLANnchorElement 
Set cnblogs = HDoc.getElementById("cnblogs") 
Dim cto As MSHTML.HTMLANchorElement 


元 
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Set cto = HDoc.createElement ("a") ' 创建 一 个 超 链 接 元 素 
With cto 
.href = "https://edu.5lcto.com/" 
target = " blank" 
.innerText = "51CTO 学 院 " 
End With 
Dim logo Rs MSHTML.HTMLImg 
Set logo = HDoc.createElement ("img") ' 创建 一 个 图 片 元 素 
logo.src = "https://www.cnblogs.com/images/logo small.gif" 
cnblogs.insertAdjacentElement where:="BeforeBegin", insertedElement:=cto ' 
在 cnblogs 开始 标签 前 面 插入 cto 超 链 接 
cnblogs.insertAdjacentElement where:="AfterBegin", insertedElement:=l0ogo " 


在 cnblogs 开始 标签 后 面 插入 LOGO 图 片 


cnblogs.insertAdjacentText where:="BeforeEnd"，Text:=" 首页" ' 在 cnblogs 结束 
标签 前 面 加 入 文本 
cnblogs .insertRdjacentHTML where:="RfterEnd"，HTML:="” <p> 此 处 换行 </p>"  ' 在 


cnblogs 结束 标签 后 面 插入 一 个 段落 
Range ("B4") .Value = HDoc.body.innerHTML 
End Sub 


13.4 Internet Explorer 浏览 器 对 象 


在 VBA 编程 中 ， 可 以 调用 网 页 浏览 器 对 象 ， 实 现 自动 操作 网 页 。 浏 览 器 对 象 具 有 很 多 
的 属性 、 方 法 和 事件 。 本 节 通 过 具体 实例 讲解 浏览 器 对 象 的 最 常用 技术 。 
首先 为 VBA 工程 添加 “Microsoft Internet Controls ”外 部 引用 ， 如 图 13-11 所 示 。 


+ “my x 
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可 使 用 的 引用 多: 
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Wisual Basic For Applications 

Microsoft Excel 15.0 Object Librar 
OLE Automation 国 
i A 0 i 0b 


soft Internet Contr' 
1crosoft PINE Objyect Library 
erosoft Vga Besic for Mpliee mh 
Mierosoft XHL, v6.0 先 级 

YBAProject 帮助 00 


YBAProject 如 
Windows Script Host Object Model 2 | 
AccessibilityCplAdnin 1.0 Type Liby 


AccountProtect 1.0 Type Library 
[ 门 aeraha+ 
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bd 
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Nicrosoft Internet Controls 


图 13-11 添加 外 部 引用 


添加 引用 后 ， 会 在 VBA 工程 中 引入 SHDocVw 的 对 象 库 。 
运行 下 面 的 程序 ， 会 使 用 默认 浏览 器 打开 百度 主页 。 
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Sub IE 对 象 入 门 () 
Dim IE As SHDocVw.InternetExplorer 
Set IE = New SHDocVw.InternetExplorer 
With IE 
.Silent = True 
-Visible = True 
.Navigate "https://www.baidu.com/" 
MsgBox "下面 将 自动 退出 浏览 器 " 
.Quit 
End With 
End Sub 


代码 分 析 : 正 对 象 的 Silent=True 表示 屏蔽 脚本 错误 ， 如 果 不 设置 这 个 属性 ， 网 页 在 打 
开 的 过 程 中 可 能 出 现 脚本 错误 ， 如 图 13-12 所 示 。 


脚本 错误 I 


[wy 


人 当前 页 面 的 却 本 发 生 措 误 。 


行 : 0 
Char: 0 
错误 : Seript error 
代码 : 
WEL: http://openapi, guanjia qq. com/fcgi-bin/getdzjs? 
cmd=urlquery_gbk_zh_en 
是 否 要 在 此 页 面 上 继续 运行 脚本 ? 


图 13-12 脚本 错误 
IE 对象 的 Navigate 方 法 的 作用 是 告诉 浏览 器 打开 哪 一 个 url 的 网 页 。 浏 览 器 对 象 还 有 
一 个 Navigate2 方法 ， 该 方法 还 可 以 用 网 页 浏览 本 地 文件 、 文 件 夹 ， 例 如 正 .Navigate2 "C:\ 


Source.txt"。 


运行 上 述 程序 ,会 在 正 浏 览 器 中 打开 百度 首页 ， 如 图 13-13 所 示 。 


Ea 
国人 EEC pracl|sae Tt, x 
文件 (站 ”编辑 (E) ”查看 (V) ”收藏 夫 (A) 工具 (0) 帮助 (H) 


人 | 
渐 闻 hao123 地 图 视频 贴吧 学 4 


Bai 合 百度 


图 13-13 自动 启动 并 且 打 开 网 页 
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本 书 以 Windows 系统 自 带 的 正 浏览 器 讲解 ， 实 际 应 用 中 也 可 以 把 Firefox、Chrome 等 
设置 为 默认 浏览 器 。 计 算 机 的 默认 浏览 器 的 设置 存储 在 如 下 注册 表 位 置 。 


HKEY CLASSES ROOT\http\shell\open\command 


从 图 13-14 可 以 看 出 ， 目 前 默认 的 浏览 器 是 搜狗 浏览 器 。 


办 注册 下 癌 [slp 
文件 (月 ” 泥 罚 (E) “查看 (V) 收藏 天 (A) 帮助 (H) 

?用 HtmlDlgSafeHelper,HtmlDlgsz * | | 名 称 区 到 E23 

>- 击 HtmlDlgsafeHelper.HtmlDlgs | 国 (iA) REG_SZ FcA\Users\ryueifuAppData\Loca\SogouExplorer\SogouExplorer.exe"|'%1" 


时 HTMLElementWrapperHTMLI | BdjDelegateExecute ”REG SZ {17FE9752-085A-4665-84CD-569794602F5C) 
>- 易 HTMLElementwrapperHTML 


0 -有 hmifle 

有 hmlfle FulwindowEmbed 
5 - 朋 HTMUnlineSoundCt.1 al 
bp -站 HrMuniinevideocul1 数值 名 称 0) 

-有 hafie WA) 

<" hp 数值 数据 
ryueifu\AppData\Local\SogouExplorer\SogouFxpl 


ED Gao 


图 13-14 查看 和 修改 默认 浏览 器 
可 以 手工 修改 ， 也 可 以 用 VBA 修改 上 述 注册 表 项 ， 例 如 把 上 述 路 径 修改 为 正 浏览 器 

的 程序 路 径 : C:\Program Files\Internet Exploreriexplore.exe， 就 可 以 把 正 浏览 器 设置 为 默认 
浏览 器 。 

以 上 是 一 个 最 简单 的 调用 浏览 器 的 实例 ， 在 实际 应 用 中 ， 可 以 在 浏览 器 中 进行 各 种 操 
作 ， 例 如 获取 网 页 数据 、 自 动 填写 表单 、 自 动 单 击 网 页 按钮 等 各 种 操作 。 

要 想 使 用 浏览 器 对 象 对 某 个 网 站 、 网 页 进行 流畅 、 准 确 的 自动 化 操作 ， 必 须 在 运行 程序 
前 事先 分 析 网 页 ， 找 出 网 页 中 核心 元 素 的 各 种 属性 。 因 此 ， 还 需要 进行 如 下 两 个 操作 。 

口 向 工程 添加 Microsoft HTML Object Library 的 引用 。 

口 使 用 浏览 器 的 开发 工具 分 析 网 页 。 

其 中 ,使 用 Microsoft HTML Object Library 的 原因 ， 主 要 是 为 了 使 用 MSHTML 对 象 库 
中 的 对 象 类 型 。 


a 避 


13.4.1 ”使 用 浏览 器 的 开发 工具 分 析 网 页 元 素 


网 页 自动 化 处 理 的 对 象 往往 是 外 部 网 站 。 网 页 的 源 代码 是 公开 的 ， 可 以 通过 查看 网 页 源 
代码 ， 了 解 网 页 的 编码 方式 、 网 页 元 素 的 层次 结构 、 自 己 感 兴趣 的 数据 等 信息 。 

但 是 ， 网 页 源 代码 往往 是 一 个 很 庞大 的 字符 串 ， 从 里 面 寻找 特定 的 元 素 非常 费时 费力 。 

大 多 数 的 浏览 器 都 有 “开发 工具 ”( 快 捷 键 都 是 F12 ) 的 功能 ， 使 用 开发 工具 ， 可 以 通过 
单 击 网 页 中 的 对 象 ， 快 速 定位 到 网 页 源 代 码 中 对 应 的 HIML 代码 ， 如 图 13-15 所 示 。 
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Bhtp//weoaidil00.com/ P - c| 加 tozloo stssta 上 - x 轩 | 
文件 (F) ”编辑 (E) 查看 (V) ， 收 茂 夫 (A) 攻 呈 风骨 大 动 (H) 

删除 浏览 历史 记录 (D)- Car+Shift+Del 

Inprivate 驻 览 四 Carl+Shift+P 

启用 跟踪 保护 (W 

ActiveX 答 远 D0 

修复 连接 问题 (O)-- 

重新 打开 上 次 浏览 会 话 (S) 

将 网 站 添加 到 “开始 ” 某 单 (M) 

查看 下 载 (N) 

弹出 窗口 阻止 程序 (P) 

SmartScreen 算 寺 器 (D) 

管理 加 载 项 (A) 


匡 容 性 视图 设置 (8B) 


订阅 此 源 (了 
源 发 现 (E) 
Windows 更 新 (U) 


性 能 仪表 板 Ctrl+Shift+U 
报告 网 站 问题 (R) 
Internet 选项 (O) 


图 13-15 打开 浏览 器 的 开发 工具 
例如 ， 在 查询 快递 的 网 站 输入 快递 单 号 ， 可 以 追踪 到 物品 的 配送 情况 。 对 于 这 个 查询 流 
程 ， 就 可 以 借助 Internet Explorer 浏览 器 对 象 来 实现 自动 化 。 在 写 程序 之 前 ， 首 先 要 用 开发 
工具 定位 到 每 个 核心 元 素 的 HTML 代码 。 
对 于 本 案例 ， 需 要 查看 快递 单 号 的 输入 文本 框 、 右 侧 的 查询 按钮 ， 以 及 下 部 显示 查询 结 
果 的 元 素 ， 如 图 13-16 所 示 。 


oan NN a 
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文件 (。 编 句 (6)。 查看 (V) 收藏 夫 IA) 工具 (T) 帮助 (H) 
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[@] 的 春 千 水 果 超 市 合 作 便利 让 答 履 
1853 号 骨 一 EN 
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12:38 13841160995 正 在 为 您 派 件 
20180528 从 辽宁 大 轿 分 所 中 心 发 出 ， 本 次 转运 目的 地 : 辽宁 大 连 沙河 口 区 海地 
10:59 公司 
2018.05.28 Tc Len 了 | 
ee 在 分 披 中 心 芽 了 大 连 分 拨 中 心 进 行 部 车 扫 泣 


图 13-16 了 解 网 页 构成 


在 浏览 器 中 按 下 快捷 键 F12， 浏览 器 下 部 出 现 一 个 窗 格 ， 在 该 窗 格 中 切换 至 “DOM 资 
源 管理 器 *"， 如 图 13-17 所 示 。 
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图 13-17 使 用 开发 工具 查看 网 页 元 素 
然后 用 鼠标 单 击 DOM 资源 管理 器 左上 角 的 箭头 指针 ， 再 把 鼠标 光标 移动 到 快递 单 号 文 
本 框 ， 下 方 窗 格 自动 定位 到 该 文本 框 对 应 的 HIML 代码 ， 可 以 看 到 该 文本 框 是 一 个 表单 控 
件 ， 其 id 是 “postid” (如 果 一 个 元 素 有 id 属性 ， 就 优先 获取 id) 
按照 上 述 操作 方法 ， 可 以 获取 到 右 侧 查询 按钮 的 HIML 代码 如 下 
<a class="btn-default btn-search" id="query"></a> 


进一步 定位 快递 的 查询 结果 ， 可 以 发 现 查询 结果 是 一 个 table 元 素 ， 如 图 13-18 所 示 。 
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图 13-18 查询 结 


该 table 元 素 的 class="result-info"。 
掌握 了 如 上 3 处 元 素 的 信息 ， 就 可 以 动手 写 代 码 了 。 
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Sub 自动 查询 快递 信息 () 


On Error GoTo Errl: 


Dim IE As SHDocVw.InternetExplorer 
Dim textbox As MSHTML.HTMLINnputElement 
Dim button As MSHTML.HTMLANchorElement 
Dim table As MSHTML.HTMLTable 
Set IE New SHDocVw.InternetExplorer 
With IE 
.Silent = True 
.Visible = True 
.Navigate "http://www.kuaidil00.com/" 
While .Busy 
Delay 1000 ' 延 时 
Wend 
Set textbox = .Document.getElementById("postid") " 定位 快递 单 号 文本 框 
Debug.Print textbox.getAttribute("id") 
textbox.Value = "3903861640775" ' 输入 一 个 快递 单 号 
Set button = .Document .getElementBYId ("query") " 定位 查询 按钮 
button .Cl1ick " 单 击 查询 按钮 
While table Is Nothing 
Delay 1000 
Set table = .Document.getElementsByClassName ("result-info") .Item(0) 
' 反复 定位 查询 结果 表 
Wend 
Debug.Print table.innerText 
.Quit ' 关闭 浏览 器 
End With 
Exit Sub 
Errl: 
Debug.Print Err.Description 
Resume 
End Sub 


代码 分 析 : 注意 代码 中 加 粗 的 部 分 ， 由 于 单 击 了 “查询 ”按钮 ， 查 询 结 果 未 必 能 立即 刷 
新 出 来 ， 所 以 要 放 在 While 循环 中 ， 只 要 table 是 Nothing 就 一 直 执 行 循 环 体 中 的 代码 ， 这 
里 运用 了 错误 处 理 的 策略 。 

其 中 ， 延 时 过 程 Delay 的 完整 代码 如 下 。 


Private 


Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long 


Sub Delay(interval As Long) 


Dim 


Savetime As Long 


Savetime = timeGetTime() 


While timeGetTime < Savetime + interval 


End Sub 


DoEvents 
Wend 


运行 上 述 程序 ， 自 动 启动 浏览 器 ， 自 动 输入 快递 单 号 ,把 查询 结果 打印 到 立即 窗口 后 ， 
自动 退出 浏览 器 。 快 递 查询 结果 信息 如 图 13-19 所 示 。 


5 office VBA 开发 经 典 一 中 级 进 阶 郑 


postid 


Llx 


2018. 05. 28 
18:53 星期 一 


快件 已 被 绘 春 街 水 果 超市 合作 便利 店 签收 
2018. 05. 28 
12:38 


[大 连 市 ] 辽 宁 大 连 沙河 口 区 海事 公司 东软 分 部 派 件 员 : 房 斌 13841 


图 13-19 打印 table 元 素 的 innerText 
以 上 程序 的 源 代码 文件 为 “实例 文档 91.xlsm”。 


13.4.2 ”处 理 超 链接 弹出 的 新 窗口 


网 页 中 往往 包含 很 多 超 链 接 ， 单 击 一 个 超 链 接 ， 有 可 能 在 原 选 项 卡 显示 新 的 页 面 ， 也 
有 可 能 在 右 侧 出 现 的 新 选项 卡 中 显示 页 面 。 这 主要 取决 于 超 链接 a 元 素 的 target 属性 ， 如 果 
target 是 _blank， 就 一 定 会 在 新 选项 卡 显示 ， 如 果 目 标 页 面 不 在 原先 选项 卡 显 示 ， 就 无 法 获 
取 目 标 页 面 的 网 页 内 容 ， 也 就 是 无 法 操作 和 控制 新 选项 卡 中 的 内 容 ， 为 此 ， 要 想 办 法 让 新 页 
面 在 原先 的 选项 卡 出 现 。 
具体 的 解决 办 法 有 如 下 3 个 。 
口 定位 并 查看 超 链接 a 元素 的 target 属性， 如 果 target 是 _blank， 把 该 属性 修改 为 
_self， 然 后 执行 超 链接 元 素 的 Click 方法 ， 这 样 就 不 会 在 新 窗口 中 弹出 。 
口 定位 并 查看 超 链接 a 元 素 的 href 属性 ， 如 果 能 找到 具体 跳 转 的 url， 可 以 使 用 正 对 象 
直接 Navigate 这 个 超 链 接 对 应 的 网 址 。 
口 利用 浏览 器 对 象 的 NewWindow2 事件 。 
下 面 通过 在 百度 首页 中 搜索 “SQL 查询 前 10 条 记录 ”这 个 关键 字 ， 在 多 个 搜索 结果 中 ， 
自动 单 击 最 上 面 的 那个 超 链接 ， 并 查看 内 容 。 
首先 用 开发 工具 获取 重要 元 素 ， 搜 索 关 键 字 文 本 框 的 这 是 kw,“ 百 度 一 下 ”这 个 按钮 
的 这 是 su， 如 图 13-20 所 示 。 
接 下 来 就 可 以 动手 写 代 码 以 实现 自动 搜索 关键 词 。 
Public IE As SHDocVw.InternetExplorer 
Sub 百度 搜索 () 
Dim KeyWord Rs MSHTML .HTMLInputTextE1ement 
Dim Search As MSHTML.HTMLINnputButtonElement 
Set IE = New SHDocVw.InternetExplorer 
With IE 
-Visible = True 
.Silent = True 
-navigate "https://www.baidu.com/" 
While .Busy 


DoEvents 
Wend 
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Set KeyWord = -document .getElementBYIQG("kw") 
KeyWord.Value = "SQL 查询 前 10 条 记录 " 
Set Search = .document .getElementById("su") 


Search.Click 
While .Busy 
DoEvents 

Wend 
Delay 3 
Debug.Print .LocationURL 
-Quit 

End With 

End Sub 
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图 13-20 查看 主要 元 素 的 属性 
运行 上 述 程序 ， 会 看 到 自动 启动 浏览 器 ， 并 在 百度 中 搜索 指定 的 关键 词 ， 最 后 ， 在 立 
即 窗口 打印 浏览 器 当前 的 url。 需 要 注意 的 是 ,浏览 器 对 象 Navigate 时 的 url 与 LocationURL 
不 同 ， 因 为 页 面 已 经 变化 了 , LocationURL 返回 的 是 最 新 的 网 址 。 立 即 窗口 的 打印 结果 如 下 。 


https://www.baidu.com/s?ie=utf-8&f=8&rsv bp=0&rsv idx=l&tn=baidug&wd=SQL%E6%9F 
SASSES8SAFSA2%E5%89%8D10%E6%9DSAl1 SE8%AESBOSESSBDS95¢rsv pq=fbf29e7b00004315&rsv_t= 
d6aaFAEu50m70X%2FryS3yv8w2g5RSw9%2FOCiFdga%2BQwFHMOKmpy3YfT5pgoSsgrqlang=cn&rsVv_ 
enter=l&rsv_sug9=eb 1 


这 个 搜索 网 址 看 起 来 很 长 ， 实 际 上 最 核心 的 部 分 是 wd=SQL.…， 其 他 参数 可 以 忽略 ， 根 
据 这 一 点 ， 以 后 就 可 以 用 浏览 器 对 象 直接 Navigate 带 有 wd 参数 的 网 址 ， 而 不 需要 进入 百度 
首页 。 

因此 ， 上 述 代 码 可 以 改写 成 如 下 形式 。 

Sub 直接 访问 () 

Set IE =- New SHDocVw.InternetExplorer 


With IE 
‘Visible = True 
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-Silent = True 
-navigate "https://www.baidu.com/s?" & "wd=" & URLEncode ("SQL 查询 前 10 


条 记录 ") 
While .Busy 
DoEvents 
Wend 
End With 
End Sub 


代码 分 析 : 对 于 网 址 中 包含 中 文 、 标 点 符号 ,或 者 发 送 的 数据 中 包含 非 英 文 的 内 容 ， 就 
需要 先 编码 ， 青 使 用 。 上 述 代码 中 URLEncode 这 个 自 定义 函数 稍 后 讲述 。 

接 下 来 需要 分 析 的 是 ， 对 于 搜索 出 的 多 个 结果 ， 如 何 自 动 获取 到 最 顶部 的 那个 超 链接 并 
且 在 原 页 面 打开 呢 ? 

再 次 利用 开发 工具 分 析 ， 可 以 发 现 规律 : 最 上 面 的 搜索 结果 是 一 个 div 元 素 ， 其 id 是 数 
字 1, 下 一 个 搜索 结果 的 id 是 2。 每 个 div 中 有 且 仅 有 一 个 超 链接 元素， 如 图 13-21 所 示 。 


EE 


Bai 度 sali10i 录 - se 下 a 


ER 新 闻 Mt 90 痢 音乐 图 片 视频 池 图 文库 更 多 » 


后 谍 HB 结 出 905S54Q00g HT 上 

蓉 T 交 据 庚申 .得 鹿 衣 Ni 关 记 革 的 方法 -用 者 泽 站 -博客 园 0 

2017 年 7 月 31 日 - SQL 和 豆油 前 10 条 的 方法 为 : 1.selecttop X * from table_name -- 查 词 前 X 东 记 

录 , 可 以 也 成 需要 的 数字 ,比如 前 10 条 。2 select lop X * fom table_naine >, 交 

japswwwenbogscomikmap ，- -下 夺 安 理 

SQL 查询 前 10 条 记录 (SqlServeymysqloraclelsybasej[ 话 法 。 博 容 园 

2011 年 2 月 15 日 -SQL 下 向 前 10 休 记录 (SqServerlmysqyoraclelsybasej[ 柏 法 分 儿 ] 这 入 文章 主 ep 而 各 
要 是 分 析 下 , a 时 省 . 部 本 语言 二 

hitpsJNeww cnbiogs comdba_n- - 下 

DN 和 生生 下 下 一 


了 
证 | 


ET 
入 机 tC BH 自 布 4 wk 


mt 人 Cn 
, | 
Wait 
conbinert -defoultt | > (560) 
yin 4 
2 v 
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图 13-21 搜索 结果 的 HTML 分 析 


但 是 ， 可 以 看 到 超 链接 a 元 素 的 target 是 _blank， 这 就 意味 着 只 要 单 击 这 个 搜索 结果 ， 
就 会 在 新 选项 卡 弹 出 页 面 。 这 不 是 我 们 期 望 的 。 
下 面 的 程序 利用 自动 修改 超 链接 元 素 的 target 属性 为 _self， 阻 止 弹出 新 窗口 。 


Sub 在 原 选项 卡 打开 首 个 搜索 结果 “修改 target () 
Dim FirstLink As MSHTML .HTMLAnchorElement 
Set IE = New SHDocVw.InternetExplorer 
With IE 
-Visible = True 
.Silent = True 
.navigate "https://www.baidu.com/s?"” & "wd=" & URLEncode ("SQL 查询 前 10 
条 记录 ") 
While .Busy 
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DoEvents 

Wend 
Delay 3 
Set FirstDiv = .document.getElementById("1") 
Set FirstLink = FirstDiv.getElementsByTagName ("a") .Item(0) 
FirstLink.setAttribute strattributename:="target", attributevalue:=" self" 
FirstLink.Click 
Delay 3 
Debug.Print .LocationURL 

End With 

End Sub 


运行 上 述 程 序 ， 程 序 会 自动 单 击 第 一 个 搜索 结果 ， 在 原 有 选项 卡 查 看 其 内 容 ， 而 不 弹出 
新 窗口 。 

此 外 ， 定 位 到 超 链接 元 素 后 ， 还 可 以 让 浏览 器 对 象 直接 Navigate 超 链 接 的 href， 例 如 下 
面 这 句 。 


IE.navigate FirstLink.getRttribute ("href") ' 或 者 FirstLink.href 


这 样 也 实现 了 在 原 选项 卡 中 显示 新 的 页 面 。 


13.4.3 ”中 文字 符 的 编码 和 解码 


由 于 每 个 国家 都 有 自己 的 语言 文字 ， 当 网 址 或 者 提交 发 送 的 数据 中 包含 这 些 字符 时 ， 可 
能 无 法 正常 解析 ， 因 此 ， 有 必要 进行 字符 的 编码 和 解码 。 
函数 URLEncode 和 URLDecode 就 是 用 于 编码 和 解码 的 自 定义 函数 ， 如 下 所 示 。 


' 编码 函数 
Public Function URLEncode (ByRef strURL As String) As String 
Dim i As Long 
Dim tempStr As String 
For i = 1 To Len(strURL) 
IE Asc(Mid(strURL, i, 1)) < 0 Then 
tempstr = "%" & Right(CStr (Hex (Asc (Mid(strURL, i, 1)))), 2) 
tempstr = "%" & Left(CStr (Hex(Asc (Mid(strURL, i, 1)))), Len(Cstr 
(Hex (Asc (Mid (strURL, i, 1))))) - 2) & tempstr 
URLEncode = URLEncode & tempstr 
ElseIf (Asc(Mid(strURL, i, 1)) >= 65 And Asc(Mid(strURL, i, 1)) <= 90) 
Or (Asc(Mid(strURL, i, 1)) >= 97 And Asc(Mid(strURL, i, 1)) <= 122) Then 
URLEncode = URLEncode & Mid(strURL, i, 1) 
Else 
URLEncode = URLEncode & "%" & Hex(Asc (Mid(strURL, i, 1))) 
End If 
Next 
End Function 
' 解码 函数 
Public Function URLDecode (BYRef strURL As String) As String 
Dim i As Long 
IE InStr (StIURL， "$%") = 0 Then URLDecode = strURL: Exit Function 
For i = 1 To Len(strURL) 
If Mid(strURL, i, 1) = "%" Then 
IE Vall("gH" & Mid(strURL, i + 1, 2)) > 127 Then 
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URLDecode = URLDecode & Chr(Val("gH" & Mid(strURL, i + 1, 2) & 
Mid(strURL, i + 4, 2))) 


Else 
URLDecode = URLDecode & Chr(Val("gH" & Mid(strURL, i + 1, 2))) 
i=i+2 


End If 
Else 
URLDecode = URLDecode & Mid(strURL, i, 1 
End If 
Next 
End Function 
例如 : 
URLEncode ("SQL 查询 前 10 条 记录 ") 
返回 的 编码 结果 如 下 。 
SQL%B2%E9%D1%AF%SC7%BO%31%30%CC%F5%BCSC7%SC2%BC 
反 过 来 : 


URLDecode ("SQL%B2%E9%D1%AF%C7%BO%31%30%CC%F5%BCSC7%C2%BC") 


返回 的 解码 结果 是 : SQL 查询 前 10 条 记录 。 
编码 和 解码 函数 并 非 唯一 的 版 本 ， 以 上 两 个 是 最 常用 的 。 
以 上 程序 的 源 代码 文件 为 “实例 文档 92.xlsm ” 。 


13.4.4 ”使 用 浏览 器 对 象 的 事件 


Intemet Explorer 浏览 器 对 象 还 支持 很 多 事件 过 程 ， 如 果 要 使 用 浏览 器 的 事件 ， 不 能 在 
标准 模块 中 声明 ， 而 是 在 类 模块 中 。 

在 VBA 工程 中 插入 一 个 类 模块 ， 重 命名 为 ClassIE， 在 类 模块 顶部 用 WithEvents 关键 
字 声 明 一 个 带 有 事件 过 程 的 浏览 器 对 象 。 

诸多 事件 中 ,NewWindow2 事件 可 用 于 处 理 新 窗口 的 问题 ， 当 单 击 页 面 中 的 超 链接 或 者 
按钮 以 后 ， 弹 出 新 窗口 之 前 会 触发 NewWindow2 事件 ， 如 图 13-22 所 示 。 


Microsoft Visual Basic for Applications - 实例 文 大 93xlsm - IcasiE(f 本 EE 
滴 文件 昌 ” 纺 澡 昌 ”视图 VW) 插入 中” 格式 (0) 调式 (D) 运行 (R) 工具 中” 外接 程序 (A) 窗口 IW) 帮助 () 

国 钥 -加 关 半 区 的 /IN PH 内 车 休 写 廊 |@ 行 5., 列 29 
[了 梧 
Public WithEvents IE As SHDocVw. InternetExplorer 


Private Sub IE NewWindow2 (ppDisp As Object, Cancel As Boole 
Cancel = True 
IE. Navigate2 URL:=NewURL 

End Sub 


图 13-22 ”使 用 正 对 象 的 事件 


事件 代码 中 的 Cancel=True， 表 示 不 弹出 新 窗口 ， 而 是 让 浏览 器 Navigate 新 的 网 址 ， 也 
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就 是 跳 转 到 超 链 接 中 的 网 址 。 
在 标准 模块 中 ， 声 明 一 个 类 的 实例 Instance， 以 后 使 用 Instance.IE 作为 浏览 器 。 


Public Instance Rs ClassIE 
Public NewURL As String 


Sub 在 原 选项 卡 打开 首 个 搜索 结果 “使 用 NewWindow2 事件 () 


Dim 
Set 
Set 


FirstLink As MSHTML.HTMLRAnchorElement 
Instance = New ClassIE 
Instance.IE = New SHDocVw.InternetExplorer 


With Instance.IE 


条 记录 ") 


End 
End Sub 


.Visible = True 
.Silent = True 
.Navigate "https://www.baidu.com/s?" & "wd=" & URLEncode ("SQL 查询 前 10 


While .Busy 
DoEvents 
Wend 
Delay 3 
Set FirstDiv = .Document.getElementById("1") 
Set FirstLink = FirstDiv.getElementsByTagName ("a") .Item(0) 
NewURL = FirstLink.href 
FirstLink.Cclick 
Delay 3 
Debug.Print .LocationURL 
With 


运行 上 述 程 序 ， 也 不 会 产生 新 窗口 ， 而 是 在 原 窗口 显示 新 的 页 面 。 
以 上 程序 的 源 代码 文件 为 “实例 文档 93.xlsm”。 


13.4.5 ”处 理 网 页 中 的 表格 数据 


很 多 网 页 上 的 数据 是 以 表格 形式 存储 的 ， 当 需要 把 网 页 表格 中 的 数据 保存 到 本 地 时 ， 可 
以 先 定位 到 table 元 素 ， 然 后 遍历 每 行 的 各 个 单元 格 即 可 。 

在 HIML DOM 对 象 模型 中 与 网 页 表格 有 关 的 对 象 有 如 下 3 个 。 

口 MSHTML.HTMLTable: table 元 素 。 

口 MSHTML.HTMLTableRow: table 中 的 tr 元素 。 

口 MSHTML.HTMLTableCell: tr 中 的 td 或 也 元 素 。 

在 实际 编程 中 ， 往 往 更 关心 表格 中 的 数据 ， 在 获取 数据 之 前 ， 先 要 了 解 一 个 table 的 行 
数 (tr 的 个 数 ) 和 table 的 列 数 (每 行 中 td 的 个 数 )。 

由 于 HTML 表格 允许 跨行 和 跨 列 ， 也 就 是 合并 单元 格 ， 从 而 使 得 每 行 的 单元 格 未 必 都 


相等 。 


对 于 普通 的 表格 ， 使 用 tablerows.length 可 以 得 到 表格 的 行 数 ，table.cells.length 可 以 得 
到 表格 所 有 的 单元 格 个 数 ， 一 般 情况 下 ， 以 上 两 个 数字 相 除 就 能 得 到 每 行 单元 格 的 个 数 ， 也 
就 是 表格 的 列 数 。 

使 用 table.innerText 可 以 一 次 性 返回 表格 中 的 所 有 文本 ， 如 果 要 存 人 Excel 单元 格 ， 就 
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需要 使 用 VBA 的 字符 串 处 理 函 数 了 。 
使 用 row.innerText 可 以 返回 某 一 行 的 所 有 文本 。 
使 用 cell.innerText 可 以 返回 某 一 个 单元 格 的 内 容 ， 这 个 方法 最 常用 。 
下 面 的 实例 演示 了 如 何 自动 下 载 象棋 网 站 中 的 表格 数据 。 
使 用 浏览 器 的 开发 工具 ， 得 到 table 的 id 属性 ， 如 图 13-23 所 示 。 


TT EL Ex | 
全 napywwvgddhesrcorynqganehmpgameaspypid-000lanes-3 “也 ”C | G wel uss. ~ ee 
文件 (由 篇 缉 (E) ”查看 (V) 收藏 去 (入 。 工具 (D 。 帮助 (H) 


您 的 季 置 : 首页 -》 象棋 棋谱 -》 许 银川 胜 后 棋 疼 (825) 从 | 
人 许 良 川 :会 部 殿 谱 先 于 棋谱 后 于 殿 详 甩 时 里 狂 和 局 棋谱 负 局 性 诺 先 胜 殿 诺 后 用 棋谱 先 和 棋谱 后 和 洪 谱 先 负 棋 疼 后 负 覃 谱 


舍 汪 | 首 , 厄 三方 PT 


原 号 比赛 昌 期 | 轮 次 台 号 E 步 数 开局 1 上 膨 比 村 名 称 更 新 时 间 EE 
1 | 2018-05-23 | 3 | 2 | 并 相川 先 星 爹 十 | 条 加 人 拉 竺 太 中 雹 对 夺 底 雹 飞 左 象 3598 | 。 2018 他 国 象 村 叶子 下 名 联 守 | 2018-05-28 14:53:41 
2 | 2017-12-07 | 3 | 2 | 郑 催 回 先 负 许 银 川 | so 仙人 指 隧 转 左 中 地 对 夺 底 雹 飞 左 象 22074 | 2017 第 六 山路 性 园 怀 名字 窒 决 赛 | 2017-12-07 11: 
3 | 2017-12-05 | 7 | 4 | 许 纲 | 川 先 浅 周 况 明 | 85 | 五 七 炮 互 过 三 丘 对 屏风 马 边 车 右 马 外 盘 河 22476 | 。 2017 第 六 届 村 桂 园 杯 福美 3 昌 | 2017-12-05 11:39: 
4 | 2017-12-03 | 4 | 2 | 许 组 川 朱 星 徐 招 | 179 仙人 指 形 转 大 中 雹 对 广 底 伯 飞 友 象 12261 | 。 2017 第 六 轴 匠 桂圆 杯 巴 赛 38 。 | 2017-12-03 22:22:27 
5 | 2017-12-02 | 1 | 2 | BB 钦 先 员 认 银 I| | us 二 角 炮 xj 进 左 马 10077 | 2017 第 六 届 甘 性 园丁 驴 窒 8 2017-12-02 12:17:03 
6 | 2017-11-10 | 29 | 4 | 许 银 川 失 胜 前 喝 | 73 飞 相对 左 中 侈 1520 | 。 2017 全 国 象 村 田子 息 级 联赛 2017-11-10 12:56-59 
团 EETIEIEIEIETEEI 飞 进 3 六 5754 | 。 2017 全 国 各 衬 雪子 及 绍 联 宁 。 | 2017-11-09 17 10-03 v 


Ct 
A BH 社 ， 骆 。 卫 
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图 13-23 网 页 表格 的 HTML 分 析 
利用 VBA 定位 网 页 表格 ， 自 动 把 表格 内 容 写 到 Excel 单元 格 中 的 具体 程序 如 下 。 


Public Sub GetTable() 
Dim IE As SHDocVw.InternetExplorer 
Dim Table As MSHTML.HTMLTable, Row Rs MSHTML.HTMLTableRow, Cell As MSHTML. 
HTMLTableCell 
Dim i As Integer, j As Integer 
Set IE = New SHDocVw.InternetExplorer 
With IE 
.Silent = True 
.Visible = True 
.navigate "http://www.gdchess.com/xqgame/xqpgame .asp?pid=0001&res=3" 
While .Busy 
DoEvents 
Wend 
Set Table = .document .getElementById ("bpwPlayergame") 
Debug.Print " 行 数 : "，Table.Rows .Length 
Debug.Print " 单元 格 数 : "，Table.Cells.Length 
Debug.Print "第 1 行 的 列 数 : "，Table.Rows (0) .Cells.Length 
Debug.Print "第 3 行 5 列 的 单元 格 内 容 : "，Table-Rows (2) .Cells (4) .innerText 
End With 
" 表格 内 容 发 送 到 单元 格 
For Each Row In Table.Rows 
主 = 主 + 1 
j=0 
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For Each Cell In Row.Cells 


es 
Sheetl.Cells (i, j) .Value = Cell.innerText 
Next Cell 
Next Row 


End Sub 


代码 分 析 : 以 上 程序 大 致 分 为 两 个 部 分 ， 一 部 分 用 于 熟悉 表格 属性 ， 了 解 一 个 表格 有 多 
少 行 多 少 列 。 另 一 部 分 用 于 把 网 页 表格 数据 发 送 到 Excel 单元 格 。 


注意 Table.Rows(2).Cells(4).innerText 表示 第 3 行 的 第 5 个 单元 格 。HIML DOM 是 0 
基 的 。 


运行 上 述 程序 ， 立 即 窗口 打印 出 这 个 表格 有 81 行 、10 列 ， 如 图 13-24 所 示 。 


行 数 : 81 

单元 格 数 : 810 

第 一 行 的 列 数 :10 _ 

第 3 行 5 列 的 单元 格 内 容 : 郑 惟 桐 先 负 许 银川 


图 13-24 打印 网 页 表格 的 重要 属性 
同时 ，Excel 单元 格 中 获得 了 网 页 表格 数据 ， 如 图 13-25 所 示 。 


[De 实例 文档 84xlsm - Excel 
EN A rm 亿 RE 讽 。 视 四 和 TITR jn 顶 


Al ~ 五 | 序号 
4 | ss c 
EE 比赛 日 期 轮 次 


2018/5/28 3 
2017/12/7 3 
TL 
4 


I 
比赛 名 称 更 新 时 间 
全 国 象 横 男子 甲 级 2018/5/28 14:53 
六 届 葡 桂 园 杯 冠军 2017/12/7 11:33 
第 六 届 葡 桂 园 杯 预 _ 2017/12/5 11:39 
弟 六 届 碧 桂 园 杯 预 2017/12/3 22:22 
第 六 届 碧 桂 园 杯 预 2017/12/2 12:17 
全 国 象棋 男子 甲 级 2017/11/10 12:56 
全 国 象棋 男子 甲 级 2017/11/9 17:10 
全 国 象棋 男子 甲 级 2017/11/5 21:42 
全 国 象 柑 男子 甲 级 2017/10/16 0:28 
全 国 象 柑 男子 甲 级 2017/8/12 22:30 
全 国 象 柑 男子 甲 级 2017/7/29 19:58 
全 国 象 机 男子 甲 级 2017/7/23 13:07 
全 国 象 横 男 子 甲 级 2017/7/20 1:27 
棋 男 子 甲 级 2017/7/19 12:33 
要 男子 甲 级 2017/6/26 1:44 


下 

对 阵 棋谱 步 
许 银川 先 胜 金波 47 
郑 惟 桐 先 负 许 银 川 80 
许 银川 先 胜 陶 汉 明 85 
许 银川 先 胜 徐 超 179 
吕 钦 先 负 许 银川 116 
许 银川 先 胜 前 强 73 
许 银 川 先 胜 徐 索 峰 65 
许 银川 先 胜 金松 169 
许 银川 先 胜 郭 凤 达 179 
曹 岩 舌 先 负 许 银 川 。 226 
许 银川 先 胜 赵 瞬 广 。 173 
许 银川 先 胜 李 智 屏 。 157 
许 银川 先 胜 李 炳 贤 65 
许 银川 先 胜 孙 逸 阳 191 
柳 大 华 先 负 许 银 川 90 


1 

2 

3 2017/12/5 

4 2017/12/3 

5 2017/12/2 1 
6 2017/11/10 .29 
和 2017/11/9 28 
8 2017/11/5 24 
10 9 2017/10/15 ,23 
11| 10 2017/8/12 20 
12 | 11 2017/7/29 18 
13| 12 2017/7/23 17 
14| 13 2017/7/19 13 
15 | 14 2017/7/18 12 
16| 15 2017/6/25 10 


膨 同 辐 辣 用 同 同 亲 同 国 辣 同 同 固 交 同 间 鸭 


17 16 2017/5/27 学 许 银川 先 胜 曹 岩 磊 91 棋 男 子 甲 级 2017/5/27 17:06 
18| 17 2017/5/7 4 许 银川 先 胜 吴 天 87 全 国 象 横 男 子 甲 级 2017/5/8 0:04 
19| 志 2017/5/6 3 许 银川 先 胜 刘 俊 达 ”89 相对 进 左 ;_6923 全 国 象棋 男子 甲 角 2017/5/7 0:31 


图 13-25 ”网 页 表格 数据 发 送 给 Excel 
以 上 程序 的 源 代码 文件 为 “实例 文档 84.xlsm”。 


13.4.6 ”自动 读 写 表单 


HTML 语言 包含 在 <form> 和 </form> 标签 中 的 控件 就 是 表单 控件 。 表 单 控件 一 般 用 
<input> 标签 来 表示 ， 使 用 不 同 的 type 属性 表达 不 同类 型 的 控件 。 
常用 的 表单 控件 有 : 复 选 框 (checkbox)、 标 签 (label)、 文 本 框 (text)、 密 码 框 (hidden)、 
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单 选 按钮 (radio)、 按 钮 (button) 等 。 
另外 ,还 可 以 用 <select> 元 素 和 <option> 元 素 形成 下 拉 框 。 


很 多 网 页 都 采用 表单 控件 作为 网 页 服务 器 和 用 户 进行 交互 的 界面 ， 因 此 ， 有 必要 了 解 如 
何 自动 获取 表单 控件 的 状态 ， 如 何 自 动 修改 表单 控件 。 


例如 ， 下 面 是 网 页 文件 forml.html 中 的 HTML 代码 ， 包 含 一 个 表单 ， 该 表单 中 包含 一 
些 常 用 的 表单 控件 。 


<html> 

<head> 
<meta charset="GB2312" /> 
<title></title> 

</head> 

<body> 
<form> 


<input id="checkboxl" type="checkbox" checked="checked" /><label>Excel</label> 

<input id="checkbox2" type="checkbox" /><label>Word</label><br /> 
<label> 用 户 : </label><input id="textl" type="text" value=""/> 

<label> 密码 : </label><input id="passwordl" type="password" value="" /><br/> 
<input id="radiol" name=" 熟练 程度 " type="radio" checked="checked"/> 

<label> 入 门 </label> 

<input id="radio2"” name=" 熟练 程度 "type="radio"/><label> 精通 </label><br /> 
<input id="buttonl" type="button" value=" 提交" onclick="javascript: 


alert (' 朋友 你 好 ! ')" /> 
</form> 
<label> 学 习 时 长 : </label> 
<select id="selectl" style="width:100px"> 
<option value="One Day">1 天 </option> 
<option value="One Week" selected="selected">l 周 </option> 
<option value="One Month">1 月 </option> 
</select> 
</body> 
</html> 


在 浏览 器 中 打开 该 网 页 文件 ， 如 图 13-26 所 示 。 


人 gl 导 ENOffceVBA 开 发 和 大 Of 人 ce VBA 发! 户 ~ 已 | 多 ENOfEccVBA 开 发 EavOfL_ x 
EECE OZ 

MExcel 口 Word 
用 户 


3 [ 


@ 和 门 0 入 
提交 


学 习 时 长 ， [天 


图 13-26 含有 表单 元 素 的 网 页 
在 使 用 HTML DOM 获取 和 定位 表单 元 素 时 ， 需 要 声明 对 应 元 素 类 型 的 对 象 变量 ， 例 如 
文本 框 元 素 应 该 声明 为 MSHTML.HTMLInputTextElement 类 型 。 


不 同类 型 的 表单 控件 ， 读 写 其 属性 的 方法 也 有 所 不 同 ， 例 如 要 更 改 文本 框 中 的 内 容 ， 可 
以 修改 其 Value 属性 ， 而 勾 选 和 取消 勾 选 复 选 框 ， 则 要 更 改 其 checked 属性 。 
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Sub 自动 填写 表单 () 


On Error GoTo Errl: 


Dim 
Dim 
Dim 
TextElement 
Dim 
Dim 


IE As SHDocVw.InternetExplorer 
checkbox2 As MSHTML.HTMLINnputElement 
username Rs MSHTML.HTMLInputTextElement, password Rs MSHTML.HTMLINnput 


radio2 As MSHTML.HTMLINnputElement 
submit As MSHTML.HTMLINnputButtonElement 


Dim Options As MSHTML.IHTMLElementCollection 
Set IE = New InternetExplorer 
With IE 


-Silent = True 

.Visible = True 

.navigate ThisWorkbook.Path & "\forml.html" 
While .Busy 


DoEvents 
Wend 
Set checkbox2 = .document.getElementById("checkbox2") ' 定位 复 选 框 
checkbox2.Checked = True ' 勾 选 复 选 框 
Set username = .document.getElementById("text1") ' 定 位" 用户 名 "文本 框 


username.Value = "liuyongfu" 

Set password = .document.getElementById("passwordl") “' 定 位 "密码 "文本 框 
password.Value = "123456" 

Set radio2 = .document .getElementById ("radio2") " 定位 单 选 按钮 
radio2.Checked = True 

Set Options = .document .getElementsByTagName ("option")' 定位 下 拉 框 


Options.Item(2) .Selected = True “选中 第 3 个 
Set submit = .document .getElementBYId("buttonl") ' 定位 "提交 "按钮 
submit.Click 

End With 

Exit Sub 


Errl: 


Debug.Print Err.Description 


End Sub 


运行 上 述 程序 ， 自 动 打 开 该 网 页 ， 程 序 会 oc J 


RY a rn re 
号 EEC 名 SoficeveAHas- x 上 介 


自动 勾 选 复 选 框 、 填 写 用 户 名 和 密码 、 自 动 单 ”| 上 9 se5 二 Vv Wen ROW 
击 “ 提 交 ” 按 钮 等 操作 ， 如 图 13-27 所 示 。 He Ba 

对 于 下 拉 框 的 自动 选择 ， 除 了 定位 select |] | 

; ; = 上 站， 廿 一 于 pr | 

下 面 的 option 以 外 ， 还 可 以 直接 指定 select 元 素 
的 selectedIndex 属性 切换 所 选项 目 。 具 体 代码 人 
如 下 。 

Dim combobox As MSHTML.HTMLSelectElement 

Set combobox =IE.document .getElementById EE 人 
(“select1”) ' 定位 到 下 拉 框 ， 而 不 是 定位 子 项 图 13-27 自动 填写 表单 


combobox.selectedIndex = 0 ' 自动 选中 第 1 项 


如 果 表 单 中 有 提交 按钮 (HTML 代码 类 似 于 <input type="submit" value="Submit" />)， 
除了 Click 这 个 按钮 以 外 ， 还 可 以 先 定位 所 属 的 form， 然 后 使 用 form.submit 方法 提交 表单 。 
以 上 程序 的 源 代码 文件 为 “实例 文档 85.xlsm”。 
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13.5 WebBrowser 控件 


WebBrowser 是 微软 提供 的 一 个 用 于 浏览 网 页 的 ActiveX 控件 ， 该 控件 的 大 部 分 成 员 、 
实现 原理 与 上 节 讲 过 的 Intermet Explorer 是 一 样 的 。 

WebBrowser 控件 与 Internet Explorer 不 同 的 是 ， 前 者 是 植 入 在 程序 中 的 一 个 控件 ， 网 
页 显示 在 窗 体 中 ， 后 者 是 一 个 对 象 ， 网 页 显示 在 独立 的 浏览 器 中 。 但 它们 处 理 的 对 象 是 一 样 
的 ， 都 是 网 页 。 

WebBrowser 控件 可 以 插入 VBA 的 用 户 窗 体 以 及 VB 、C# 等 窗 体 中 ， 还 可 以 插入 
Word 文档 、Excel 工作 表 上 。 一 般 情况 下 ，VBA 的 控件 工具 箱 中 找 不 到 该 控件 ， 需 要 在 
控件 工具 箱 右 击 ， 在 右键 菜单 中 选择 “附加 控件 ”命令 ， 在 “附加 控件 ”对 话 框 中 ， 找 到 
“Microsoft Web Browser” 并 日 勾 选 ， 如 图 13-28 所 示 。 


Microsoft Visual Basic for Applications - 实例 文档 94xsm - [实例 文档 94xlsm = UserForm1 (UserForm)] 
增 文件 日 ”篇 加 上 视图 VW) 插入 中” 想 式 (QO) 调式 (D) 运行 R) 工具 中” 外接 程 序 (A) 窗口 WW) 帮助 t) 
国名 - 回 | 六 性 总 nl 2IO 目 


可 用 控件 (A): 


own C 
DMicrosoft Visual Studio Tools for Offce Ru 
加 Microsoft Web Browser 

ek 


ID MicrosoftVisualStudio. 0 Control - 
MMC leonControl class 


Microsoft Web Browser 


位 置 CAWindows\System32\ieframe.dll 


图 13-28 添加 ActiveX 控件 


控件 工具 箱 中 出 现 一 个 地 球形 状 的 控件 ， 这 样 就 可 以 把 该 控件 拖 放 到 用 户 窗 体 中 使 用 。 
注意 ， 用 户 窗 体 中 加 入 WebBrowser 控件 以 后 ，VBA 工程 会 自动 添加 “ Microsoft Internet 
Controls” 的 外 部 引用 ， 如 图 13-29 所 示 。 

用 户 窗 体 上 插入 WebBrowser 控件 之 后 ， 就 可 以 使 用 该 控件 浏览 本 地 、 外 部 网 页 ， 也 可 
以 用 来 显示 本 地 的 XML 文件 、gif 图片 等 。 例 如 : 

UserEorml .WebBrowserl .Navigate “https://www.baidu.com/” 
就 可 以 在 用 户 窗 体 中 看 到 百度 首页 

使 用 WebBrowser 控件 同样 可 以 实现 网 页 自动 化 ， 与 Internet Explorer 效果 差不多 。 

本 节 首 先 讲解 如 何 访问 内 嵌 于 网 页 中 的 过 ame 框架 里 的 元 素 。 然 后 通过 自动 登录 QQ 邮箱 、 
自动 查看 收 件 箱 中 未 读 邮件 的 个 数 、 自 动 退出 登录 ,讲解 WebBrowser 控件 的 使 用 技术 。 


第 13 章 网 页 自动 化 全 5 


可 使 用 的 引用 以) 


Vi sl Basic For Applications 如 
Yiorosoft Exeel 15.0 Dbject Litrar 
OLE Autonation 

crosoft Office 15.0 Object Libre 浏览 四) 
crozoft Forns 2 0 Object Libr er 


] L L 


全 
Emma od 
erosoft Visual Basic for Applice 优先 级 

区 到 | 


erosoft XML, 6.0 帮助 00 


ndows Script Host Object Model 
sibilityCplAdnin 1.0 Type Libl < 
mt Pratecs 1 0_Tome ibrar 


1 lei » 


Mierosoft Internet Controls 
定位 : C:Windors\Systen32\iefrane. dll 
语言 标准 


| 


图 13-29 自动 添加 “Microsoft Internet Controls ”外 部 引用 


13.5.1 处 理 iframe 


iframe 也 是 HTML 语言 中 的 一 个 标签 ， 使 用 这 ame 框架 可 以 把 另 一 个 网 页 内 艇 到 主体 
网 页 中 。iframe 的 src 属性 指明 了 该 框架 的 实际 网 址 。 因 此 ， 包 含 过 ame 的 网 页 可 以 认为 是 
另 一 个 网 页 寄生 在 主体 网 页 中 。 

例如 ，IP 查询 的 网 址 是 http://www.ip138.com/， 在 正中 打开 该 网 页 后 ， 在 网 页 中 部 可 
以 看 到 本 机 的 他 地 址 和 地 理 位 置 。 

使 用 浏览 器 的 开发 工具 来 检查 元 素 ， 会 发 现 卫 地 址 和 地 理 位 置信 息 并 不 在 主体 网 页 中 ， 
而 是 位 于 一 个 过 ame 的 <center>...</center> 节点 中 ， 该 过 ame 的 url 为 : http://2019.ip138. 
com/ic.asp， 如 图 13-30 所 示 。 


本 SE (=.19 BE 
(JE 加 toymwipl3tcor 本 DC | 西 platt 本 -于 ASK 查询 - x | | 人 i 
En 人 
汉字 简体 繁体 转 殉 国内 国际 机 杜 查 齐 品牌 排行 榜 区 块 链 测 星 器 给 
在 线 翻 译 货币 汇率 转贴 工具 在 线 度 衡量 桂 换 器 邮编 查询 区 号 查询 
身份 证 叶 码 查询 验证 快递 查询 EMS 吉 淘 全 国 各 地 车 条 相交 表 车 辆 交通 违章 查询 
www.ip138.com iP 查 询 (搜索 ijP 地 址 的 地 理 位 着 ) 
写 的 JP 是 ，[112.42. 5. 161] 来 自 ， 这 宁 当 大 这 市 移动 
中 在 下 面 输入 框 中 输入 您 要 查询 的 刘 地 址 或 者 域名 ,点击 查询 按钮 即 可 查询 沪 iP 所 属 的 区 域 . 阅 
| eT 尖 埋 这 ”网 党 ”Mi 响 应 。 。 务 查 咽 。。” 内 存 。。” 仿 x 
叶 喇 回 > 二 EC 
rt 入 IE Bl 算 布 3 事 才 更改 
kheady-x/head> pr 
oa 
2 iv class-ourapperny 
civ class="mdule wod-headercy erdiv> 
cy el 
4 uly ea 


hi Sp 机理 信 轩 )<Jh> 
[ditrane sre-"htto://2019. ip138.com/ic.asp” frameborder="0" scrolline-"no” rel-"nofollow") 


meta ttp-eqeivcrcantent-typer cantent="tect/htnl; charset< 本 2312"ycjaetay 
<title> 交 的 ITP 进 直 《Atitle> 
heed> 
dy tyler-"margin: opi"> 
ccenter> 训 HIP 是 :; 112.42.5.151] 目下 
rml body cvwrapper cvmoduie mame Fml bo 


图 13-30 ”网 页 中 包含 这 ame 
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对 于 这 ame 框架 中 的 网 页 元 素 ， 可 以 先 从 主体 网 页 的 HTML 文档 定位 到 这 个 过 ame， 
然后 使 用 过 ame. contentWindow.document 获取 框架 的 HIML 文档 ， 进 而 读 写 框架 中 的 元 素 。 

在 用 户 窗 体 上 放置 一 个 WebBrowser 控件 和 一 个 CommandButton 控件 。 命 令 按钮 控件 
的 单 击 事件 代码 如 下 。 


Private Sub CommandButton1l Click() 
Dim HDocl As MSHTML .HTMLDocument 
Dim HDoc2 As MSHTML.HTMLDocument 
Dim iframe As MSHTML.HTMLIFrame 
With Me.WebBrowserl 
.Silent = True 
.Navigate "http://www.ipl38.com/" 
While .Busy 
DoEvents 
Wend 
Set HDocl = .document ' 取得 WebBrowser 控件 的 文档 ， 赋 给 HDoc1 
End With 
Set iframe = HDocl.getElementsByTagName ("iframe") .Item(0) ' 第 1 个 框架 
Set HDoc2 = iframe.contentWindow.document 
Debug.Print HDoc2.DocumentElement .outerHTML 
End Sub 


启动 用 户 窗 体 ， 单 击 用 户 窗 体 中 的 命令 按钮 ，WebBrowser 控件 首先 显示 卫 查询 主页 的 
页 面 内 容 ， 然 后 弹出 一 个 “拒绝 的 权限 ”异常 对 话 框 ， 如 图 13-31 所 示 。 


[rr 


加 


[Er 


Private Sub CommandButton1_Click() 


Dim HDoc1 As MSHTML.HTMLDocument Moeof Vi Res 
Dim HDoc2 As MSHTML .HTMLDocument 运行 时 江油 ,To 
Dim iframe As MSHTML.HTMLIFrame 89 积 限 


With Me.WebBrowser1 
.Silent = True 
-Navigate "http://www.ip138.com/" 
While .Busy 
DoEvents 
Wend 
Set HDocl = .document ' 取 得 WebBrowser 控 件 的 文档 ， 赋 给 HDoc1 


结束 中) 才 助 00 


tElementsByTagName("iframe").Item(8) ' 第 1 个 框架 
[Set HDoc2 = iframe.contentwindow.document 
Debug.Print HDoc2.DocumentElement .outerHTML 

End Sub 


图 13-31 在 WebBrowser 控件 中 显示 过 ame 指向 的 页 面 


Set HDoc2 = iframe.contentWindow.document 这 行 代码 能 否 正常 执行 ， 与 网 站 有 关 ， 有 
的 网 站 可 以 正常 运行 。 

如 果 出 现 上 述 异 常 ， 可 以 采用 页 面 跳 转 的 方式 ， 也 就 是 让 WebBrowser 控件 Navigate 一 
下 过 ame 元 素 的 src 属性 中 设置 的 url。 完 整 代码 如 下 。 


Private Declare PtrSafe Function timeGetTime Lib “winmm.dll" () Rs Long 
Private Sub CommandButton] Click() 

Dim HDocl As MSHTML.HTMLDocument 

Dim HDoc2 As MSHTML.HTMLDocument 

Dim Frame As MSHTML.HTMLIFrame 
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Dim center As MSHTML.HTMLObjectElement 

With Me.WebBrowserl 
.Silent = True 
.Navigate "http://www.ipl38.com/" 
While .Busy 

DoEvents 
Wend 
Delay 3000 
Set HDocl = .document ' 主页 的 文档 
Set Frame = HDocl.getElementsByTagName ("iframe").Item(0) 
.Navigate Frame.getAttribute ("src") ' 跳 转 到 iframe 指定 的 url 
While .Busy 
DoEvents 

Wend 
Delay 3000 
Set HDoc2 = .document ' 此 处 就 是 框架 的 文档 
Set center = HDoc2.getElementsByTagName ("center") .Item(0) 
MsgBox center.innerText, vbInformation 

End With 

End Sub 


Private Sub WebBrowserl NewWindow2 (ppDisp As Object, Cancel As Boolean) 
Cancel = True 
Me .WebBrowserl .Navigate2 Me.WebBrowserl.document .activeElement.href 
End Sub 


Sub Delay(interval As Long) 
Dim Savetime As Long 
Savetime = timeGetTime () 
While timeGetTime < Savetime + interval 
DoEvents 
Wend 
End Sub 


以 上 程序 中 ， 首 先 打 开 主 页 ， 然 后 从 主页 文档 中 查找 到 frame 跳 转 的 url，3 秒 后 在 原 
浏览 器 控件 中 继续 打开 这 个 url， 进 而 查找 到 center 元 素 。 

运行 上 述 程序 ，WebBrowser 控件 最 后 显示 的 是 框架 页 面 内 容 ， 并 且 弹 出 显示 结果 的 对 
话 框 ， 如 图 13-32 所 示 。 


本 轴 下 大 ,TI11Z 全民 IGI] 用 再 ， 订 于 泊 天 证 币 种 条 


@ rn 


图 13-32 打印 这 ame 中 的 内 容 
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另外 ， 还 有 一 类 frame 框 架 ， 访问 这 类 框架 文档 的 方式 是 : Set HDoc=frame. 
contentDocument。 


以 上 程序 的 源 代码 文件 为 “实例 文档 86.xlsm”。 
13.5.2 ”自动 查看 邮箱 信息 


在 网 页 自动 化 的 过 程 中 ,经常 遇 到 涉及 账户 登录 的 网 页 ， 下 面 这 个 实例 实现 了 在 
WebBrowser 控件 中 自动 登录 邮箱 、 查 看 未 读 邮件 个 数 、 退 出 邮箱 等 操作 。 

通过 开发 工具 检查 邮箱 登录 页 面 ， 发 现 用 户 名 和 密码 输入 框 处 于 一 个 这 ame 里 面 ， 如 
图 13-33 所 示 。 


图 13-33 ”用户 名 和 密码 位 于 过 ame 中 


这 个 过 ame 的 这 是 login_frame， 因 此 非常 容易 定位 ， 如 果 复 制 这 ame 的 src 属性 ， 粘 
贴 到 浏览 器 地 址 栏 中 并 按 回 车 键 ， 可 以 清楚 地 看 到 登录 界面 ， 如 图 13-34 所 示 。 


本 
DB epriniprogrzaqeomyagi tt DP AC | 身 wptooraqqcom 
Er EEC 


Le | 
< 国人 ce 


uick Sion-in Different ID 


19488012@qq.com 


图 13-34 直接 浏览 这 ame 的 src 
有 以 上 的 基础 研究 为 依据 ， 就 形成 了 如 下 的 开发 思路 和 流程 。 
Step 1: WebBrowser 控件 Navigate 邮箱 登录 的 主页 。 
Step 2: 定位 过 ame， 并 且 Navigate 这 个 过 ame 的 src。 
Step 3: 切换 到 选项 卡 “Different ID ”， 使 得 用 户 名 和 密码 输入 框 可 见 。 
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Step 4: 定位 用 户 名 和 密码 输入 框 ， 并 且 自 动 输入 账号 信息 。 

Step 5: 自动 单 击 “Sign In” 按 钮 ， 登 录 邮 箱 。 

Step 6: 进入 邮箱 ， 定 位 并 获取 页 面 左 侧 的 “Inbox”。 

Step 7: 获取 到 未 读 邮件 个 数 后 ， 定 位 并 获取 页 面 右上 角 的 “Sign Out”， 退 出 登录 。 
具体 程序 代码 如 下 。 


Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () Rs Long 
Private Sub CommandButton] Click() 
Dim Frame As MSHTML.HTMLIFrame 
Dim ChangeUser Rs MSHTML.HTMLANnchorElement 
Dim UserName As MSHTML.HTMLINnputTextElement 
Dim Password As MSHTML.HTMLINnputTextElement 
Dim Login As MSHTML.HTMLINnputButtonElement 
Dim Inbox Rs MSHTML.HTMLANnchorElement 
Dim Links As MSHTML.HTMLElementCollection 
Dim link Rs MSHTML.HTMLANchorElement 
With Me.WebBrowserl 
.Silent = True 
.Navigate "https://en.mail.qq.com/cgi-bin/loginpage" 
While .ReadyState <> READYSTATE COMPLETE 
DoEvents 
Wend 
Delay 3000 
Set Frame = .Document.getElementById("login frame") 
.Navigate Frame.getAttribute("src") 
While .ReadyState <> READYSTATE COMPLETE 
DoEvents 
Wend 
Delay 3000 
Set ChangeUser = .Document .getElementById("switcher plogin") 
ChangeUser .Click 


Delay 3000 

Set UserName = .Document.getElementById("u" 
UserName.Value = "" 

Delay 3000 

UserName.Value = "19488012@qq.com" 

Set Password = .Document.getElementById("p") 


Password.setAttribute strAttributeName:="value", AttributeValue:="]123456" 
Set Login = .Document.getElementById ("login button") 
Login.click 
Delay 3000 
Set Inbox = .Document.getElementById("folder 1") 
MsgBox " 未 读 邮 件 : " & Inbox.getAttribute ("title") 
Set Obj = .Document .getElementsByTagName ("a") 
For Each link In Obj 
Debug.Print link.innerText 
If link.innerText = "Sign out" Then 
.Navigate link.getAttribute("href") 
Exit For 
End If 
Next link 
End With 
End Sub 


Private Sub WebBrowserl NewWindow2 (ppDisp As Object, Cancel As Boolean) 
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Cancel = True 
Me .WebBrowserl .Navigate2 Me.WebBrowserl.Document .activeElement.href 
End Sub 


Sub Delay(interval As Long) 
Dim Savetime As Long 
Savetime = timeGetTime() 
While timeGetTime < Savetime + interval 
DoEvents 
Wend 
End Sub 


代码 分 析 : WebBrowser 控件 有 很 多 可 用 的 事件 过 程 ， 本 实例 使 用 了 NewWindow2 事件 ， 
以 防止 弹出 新 窗口 。 

启动 用 户 窗 体 ， 单 击 “ 登 录 QQ 邮箱 ”按钮 ， 可 以 看 到 WebBrowser 控件 中 自动 登录 邮 
箱 ， 并 且 对 话 框 弹出 未 读 邮 件 的 个 数 ， 如 图 13-35 所 示 。 


i , Lm 


二 此 同 闪 二 要 到 全 下 过 攻 晓 半身 “Tencent nc (让 益生 和 发布] 的 “qeenCapture Control 、 基 条 信任 各 寻 及 如 开斋 并 人 这 运 行 记 瑶 顺 ,再 音 本 此 处 x 


En 四 
a x = ET 
登陆 QQ 邮箱 
图 13-35 自动 登录 邮箱 
手工 关闭 MsgBox 对 话 框 后 ， 自 动 退出 邮箱 ， 如 图 13-36 所 示 。 
Uf 一 so rp ee fm 天 号 
MOileems mex ome | 


You have signed out QQMail successfully. Sign in again 


About Tencent | Terms of Semice | Contact Us | ©1996 - 2018 Tencent Inc al Ronts Reserved 


登陆 QQ 邮箱 
图 13-36 ”自动 退出 登录 
以 上 程序 的 源 代 码 文件 为 “实例 文档 94.xlsm”。 
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13.5.3 ” 延 时 等 待 处 理 


Internet Explorer 浏览 器 对 象 和 WebBrowser 控件 引用 的 是 同一 个 对 象 库 ， 能 够 处 理 的 网 
页 自动 化 业务 大 致 相同 ， 其 实 都 是 浏览 器 对 象 。 

调用 浏览 器 对 象 的 Navigate 、Refresh 方法 ， 或 者 单 击 页 面 中 的 按钮 引起 页 面 的 变化 ， 
在 页 面 变化 尚未 完成 之 前 ， 不 能 访问 浏览 器 的 文档 对 象 。 因 此 ， 在 使 用 这 些 方法 之 后 ， 一 般 
要 加 入 一 定量 的 延 时 ， 等 待 页 面 完 全 就 绪 后 再 对 其 操作 。 

可 以 采用 的 延 时 策略 分 为 灵活 延 时 和 固定 延 时 两 类 。 

灵活 延 时 是 在 循环 体 中 一 直 判 断 浏览 器 的 readystate 是 否 等 于 4， 或 者 判断 Busy 属性 是 
不 是 为 Tme。 这 两 个 条 件 既 可 以 单独 使 用 ， 也 可 以 与 Or 组 合 使 用 。 具 体 特 点 是 页 面 没 有 刷 
新 出 来 或 者 处 于 忙碌 状态 ， 代 码 处 于 循环 体 中 ， 页 面 一 旦 就 绪 ， 就 跳出 循环 。 总 体 的 等 待 时 
间 取 决 于 网 速 、 网 页 的 打开 速度 。 


Sub 等 待 就 绪 () 
Dim IE As SHDocVw.InternetExplorer 
Set IE = New SHDocVw.InternetExplorer 
With IE 
.Silent = True 
"Visible = True 
-navigate "http://www.gdchess.com/" 
While .readyState <> READYSTATE COMPLETE Or .Busy 
DoEvents 
Wend 
Debug.Print .Document .body.innerhtml 
End With 
End sub 


代码 分 析 : 上 述 程序 中 ,斜体 部 分 就 是 延 时 等 待 处 理 ， 如 果 去 掉 或 注释 掉 这 3 行 代码 ， 
再 次 运行 会 造成 “自动 化 错误 ”， 如 图 13-37 所 示 。 


Microsoft Visual Basic 
= 


运行 时 错误 “-2147467259 (80004005)” 
自动 化 Wutomnation) 错误 


才 助 0 
图 13-37 不 延 时 造成 的 错误 


注意 ”以 上 所 述 的 灵活 延 时 未 必 在 任何 情况 都 好 用 ,很 多 情况 下 使 用 了 上 述 延 时 技术 经 
常 导致 如 下 两 种 异常 。 

口 程 序 代 码 滞 留 在 循环 体 中 出 不 去 ， 造 成 死 循 环 (While 后 面 的 条 件 一 直 是 False)。 

口 延 时 之 后 ,使 用 GetElement 之 类 的 方法 获取 不 到 页 面 上 的 元 素 。 
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如 果 灵 活 延 时 不 能 很 好 地 解决 问题 ， 可 以 考虑 固定 延 时 。 常 用 的 固定 延 时 写法 如 下 。 


Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () Rs Long 
Sub Delayl (second As Integer) 

Application.Wait Now + TimeValue ("00:00:0" & second) 
End Sub 
Sub Delay2 (millisecond As Long) 

Dim Savetime As Long 

Savetime = timeGetTime () 

While timeGetTime < Savetime + millisecond 

DoEvents 

Wend 

End Sub 


上 述 代 码 中 过 程 Delayl 的 延 时 单位 是 秒 ，Delay2 的 延 时 单位 是 毫秒 。 例 如 ，Delayl 
10 可 以 延 时 10 秒 ，Delay2 3000 可 以 延 时 3 秒 ， 把 这 些 语句 插入 浏览 器 的 Navigate 方法 
之 后 即 可 。 

固定 延 时 技术 可 以 自行 指定 等 待 时 间 长 短 ， 但 是 缺点 很 明显 : 不 知道 浏览 器 的 状态 。 

无 论 是 哪 一 种 延 时 技术 ， 根 本 原理 都 是 在 无 限 循环 体 中 使 用 DoEvents 转让 控制 权 。 


13.5.4 ”确保 元 素 的 获取 


浏览 器 中 打开 页 面 时 ， 网 页 上 的 各 个 元 素 不 是 同时 出 现 的 ， 用 GetElement 之 类 的 方法 
获取 页 面 中 尚未 出 现 的 元 素 时 就 会 导致 错误 。 有 时 即使 同时 使 用 了 灵活 延 时 和 固定 延 时 ， 还 
是 不 能 确保 获取 元 素 。 
对 于 使 用 以 getElements 开头 的 方法 返回 元 素 集合 的 场合 ， 判 断 其 是 不 是 Nothing， 如 
果 是 Nothing， 就 在 循环 体 中 一 边 延 时 一 边 获取 ， 直 至 不 是 Nothing 为 止 。 
例如 ， 下 面 的 程序 在 循环 体 中 一 直 获取 一 个 框架 。 
Sub 确保 集合 中 的 一 个 元 素 出 现 () 
Dim IE As SHDocVw.InternetExplorer 
Dim frame As MSHTML.HTMLFrameElement 
Set IE = New SHDocVw.InternetExplorer 


With IE 
.Silent = True 


:Visible = True 
navigate "http://www.gdchess.com/" 
While .Busy 


DoEvents 

Wend 

Set frame = Nothing 

Do 
Set frame = .Document .getElementsByTagName ("iframe") .Item(0) 
DoEvents 
If frame Is Nothing = False Then Exit Do 

Loop 

Debug.Print frame.outerHTML 

End With 


End Sub 
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对 于 使 用 getElementById 获取 元 素 的 场合 ， 使 用 ISNull 来 判断 是 不 是 已 经 获取 到 ， 如 
果 获 取 到 就 退出 循环 。 
下 面 的 程序 在 页 面 中 不 断 获 取 一 个 指定 id 属性 的 div 元 素 。 


Sub 确保 具有 id 的 元 素 出 现 () 
Dim IE As SHDocVw.InternetExplorer 
Dim div As MSHTML.HTMLDivElement 
Set IE = New InternetExplorer 
With IE 
.Silent = True 
.Visible = True 
.navigate "http://www.w3school.com.cn/h.asp" 
While .Busy 
DoEvents 
Wend 
Set div = Nothing 
Do While IsNull(.Document.getElementById("maincontent")) 
DoEvents 
Loop 
Set div = .Document.getElementById("maincontent") 
Debug.Print div.outerHTML 
End With 
End Sub 


使 用 了 上 述 策 略 ， 只 有 当 要 找 的 目标 元 素 顺 利 获 取 到 才 继 续 运 行 后 面 的 代码 ， 从 而 增强 
程序 的 健壮 性 。 
以 上 程序 的 源 代码 文件 为 “实例 文档 88.xlsm”。 


13.5.5 ”获取 和 操作 已 经 打开 的 浏览 器 网 页 


一 般 情 况 下 ,使 用 New、CreateObject 创建 的 浏览 器 对 象 ( WebBrowser、Intemet Explorer)， 
在 程序 代码 中 具有 持久 控制 权 ， 可 以 读 写 浏览 器 对 象 的 各 方面 。 

实际 上 ， 对 于 桌面 上 已 经 存在 的 浏览 器 网 页 ， 也 可 以 用 程序 代码 获取 并 进一步 对 其 操作 
控制 。 

如 果 VBA 工程 中 已 经 添加 了 “Microsoft Intemet Controls” 的 外 部 引用 ， 使 用 SHDocVw- 
ShellWindows 可 以 获取 已 经 打开 的 所 有 浏览 器 网 页 、 所 有 文件 资源 管理 器 窗口 。 

假设 在 正 浏览 器 中 打开 了 两 个 网 页 ， 并 且 开 启 了 两 个 文件 资源 管理 器 ， 如 图 13-38 所 示 。 

下 面 的 程序 可 以 遍历 各 个 窗口 的 信息 到 Excel 单元 格 中 。 


Public Browser As SHDoCVW.WebBrowser 
Public Sub 遍历 所 有 浏览 器 窗口 () 
Dim AllWindows Rs SHDocVw.ShellWindows 
Set AllWindows = New SHDocVw.ShellWindows 
Dim i As Integer 
二 = 1 
Range ("A" & i & ":E" & i) -Value = Array(" 名 称 "，" 类 型 "，" 标题 "，" 网 址 / 路径 "，" 句柄 ") 
For Each Browser In AllWindows 
:i 学 和 
Range("A" & i & ":E" & i).Value = Array (Browser.Name, TypeName (Browser. 
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document), Browser.LocationName, Browser.LocationURL, Browser .Hwnd) 
Next Browser 
End Sub 
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图 13-38 事先 打开 若干 窗口 
代码 分 析 : 浏览 器 网 页 窗口 的 Name 属性 、Browser.document 类 型 ， 与 文件 资源 管理 器 
窗口 不 同 ， 另外， 文件 资源 管理 器 的 LocationURL 属性 是 以 fle:/ 开头 的 ， 根 据 这 些 特点 就 
可 以 区 分 开 哪 些 是 网 页 窗口 ， 哪 些 是 资源 管理 器 窗口 。 
运行 上 面 的 程序 ， 单 元 格 中 列 出 各 个 窗口 的 5 个 比较 重要 的 属性 ， 如 图 13-39 所 示 。 


国 日 6- SO-= 89 lem -Excel 


到 。 插 人 A 页 醒 布 局 公式 娄 据 。 市 风 机。 开发 IJ 具 Mm 二 项 
Al 汪 五 ‖ 名 称 


B c | D | | 
甫 [ 才 称 类 型 标题 网 址 /路径 各 栖 
2 Windovs 资源 营 理 器 IShellFolderYiewDual3 Pyth zile:///C:/Fython27 328190 


on27 
3 Internet zxplorer ETILDocunent 百度 一 下 ， 你 就 知 这 https ://www, baidu. con/ 8652242 
4 Internet Explorer FTNLDocunent 邮政 编码 大 全 _ 全 国 http: //www. ip138. con/nost/ 5652242 
5 _Windovs 资源 管理 器 IShellFolderyiewDual3 Debug file:///D:/Debug 657266 


图 13-39 窗口 对 象 的 重要 属性 


这 里 强调 一 下 句柄 值 ， 因 为 多 个 网 页 标签 可 以 共用 一 个 浏览 器 窗口 ， 所 以 句柄 是 一 样 
的 。 而 资源 管理 器 是 相对 独立 的 窗口 ， 所 以 句柄 值 不 同 。 上 述 程序 中 的 变量 Browser 也 可 以 
声明 为 Internet Explorer， 它 和 WebBrowser 对 象 的 成 员 相同 -。 

既然 可 以 获取 到 提前 打开 的 网 页 ， 如 何 对 某 一 个 特定 的 网 页 进行 操作 和 控制 呢 ? 判断 的 
技巧 就 是 根据 这 个 网 页 与 其 他 网 页 属性 的 不 同 。 

假设 桌面 上 已 经 打开 了 多 个 网 页 ， 下 面 的 程序 可 以 把 “百度 一 下 ”的 那个 网 页 赋 给 对 象 
变量 Browser， 从 而 对 其 单独 操作 。 

Public Sub 操作 已 经 打开 的 浏览 器 网 页 () 


Dim AllWindows As SHDocVw.ShellWindows 
Set AllWindows = New SHDocVw.ShellWindows 
Dim H As New HTMLDocument 

For Each Browser In AllWindows 
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IE Browser.Application = "Internet Explorer" Then 
If Browser.LocationURL Like "https://www.baidu.com/*" Then Exit For 


End If 
Next Browser 


With Browser 


-MenuBar = False " 隐藏 菜单 栏 
.StatusBar = True " 显示 浏览 器 的 状态 栏 
.statusText = "程序 正在 运行 

Delay 2 

Set H = .document 


H.getElementById("kw") .Value = "VBA 实现 网 页 自动 化 " 


H.getElementById("su") .Click 
Delay 2 
.Refresh 
Delay 2 
-GoBack 
Delay 2 
.Stop 
Delay 2 
.Quit 
End With 
End Sub 


" 刷新 网 页 
" 后退 
' 停止 


' 退 出 


代码 分 析 : 在 For 循环 中 遍历 各 个 窗口 时 ， 第 一 层 下 判断 用 于 过 滤 文 件 资源 管理 器 窗 
口 ,第 三 层 下 判断 是 找 出 url 中 包含 指定 网 址 的 网 页 ， 如 果 找 到 就 跳出 For 循环 ， 之 后 ， 就 
可 以 在 程序 代码 中 通过 读 写 Browser 这 个 对 象 变量 来 操控 实际 存在 的 网 页 了 。 

运行 上 述 程序 ， 隐 藏 浏览 器 的 菜单 栏 ， 显 示 状 态 栏 ， 并 设 定 状态 栏 中 的 文字 。 然 后 定位 


各 个 有 关 网 页 元 素 输入 内 容 并 执行 搜索 ， 如 图 13-40 所 示 。 
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图 13-40 ”获取 和 操作 正在 运行 的 正 对 象 
以 上 技术 对 于 网 页 自动 化 程序 的 调试 带 来 很 大 方便 ， 因 为 不 需要 从 头 创建 浏览 器 ， 从 网 


页 中 间 的 任何 一 个 画面 和 阶段 都 可 以 读 写 现存 的 网 页 。 


13.5.6 ”获取 和 操作 文件 资源 管理 器 窗口 


系统 的 文件 资源 管理 器 窗口 也 是 一 种 WebBrowser 对 象 ， 


同样 可 以 实现 自动 化 。 
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:二 4 二 


彼 行 


手工 打开 多 个 资源 管理 器 窗口 ， 


下 面 的 程序 ， 可 以 把 特定 的 一 个 窗口 赋 给 对 象 变量 


Browser， 进 一 步 更 改 窗口 的 大 小 ,改变 浏览 器 的 路 径 ， 自 动 前 进 和 后 退 ， 自 动 退出 。 


Sub 自动 操作 资源 管理 器 () 

On Error GoTo Errl: 

Dim AllWindows As SHDocVw.ShellWindows 

Delay 2 

Set AllWindows = New SHDocVw.ShellWindows 

For Each Browser In AllWindows 
If Browser.Application = "Windows 资源 管理 器 " Then 

If Browser.LocationName = 

End If 

Next Browser 


With Browser 
.RddressBar = 
.FullScreen 
:Left = 200 
.Top = 200 
Width = 1000 
.Height = 500 
.resizable = 
Delay 2 
.navigate "E:\CDOSendMail" " 变更 路 径 
While .readyState <> READYSTATE COMPLETE 

DoEvents 
Wend 
.navigate "D:\Debug" 
Delay 2 
‘GoBack 
Delay 2 
:Refresh 
Debug.Print .LocationName, 
Delay 2 
.Quit 
End With 
Exit Sub 
Errl: 
Debug.Print Err.Description 
End Sub 


运行 上 述 程序 ， 资 源 管理 器 窗口 自动 更 改 为 指定 的 大 小 和 位 置 ， 


False 
False 


False 


:LocationURL 


' 隐藏 地 址 栏 
' 不 使 用 全 屏 


"Python27" Then Exit For 


' 不 可 更 改 窗口 大 小 


如 图 13-41 所 示 。 
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潭 ia D msipyhon2 Tpy Ee 
Ea 
入 了 
sn 
忆 吕 加 
er 
es 
| ) 5 人 
图 13-41 获取 和 操作 资源 管理 器 窗口 
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程序 运行 结束 后 ， 自 动 关闭 上 述 窗口 。 
以 上 程序 的 源 代码 文件 为 “实例 文档 89.xlsm”。 


13.6 XMLHTTP 


XMLHTTP 是 一 种 浏览 器 对 象 ， 可 用 于 模拟 HTTP 的 GET 和 了 POST 请 求 。XMLHTTP 
提供 客户 端 同 HTTP 服务 器 通信 的 协议 。 客 户 端 可 以 通过 XMLHTTP 对 象 向 HTTP 服务 器 
发 送 请 求 并 使 用 微软 XML 文档 对 象 模型 处 理 回应 。 
XMLHTTP 用 于 网 页 自动 化 方面 ， 可 以 打开 一 个 指定 的 网 址 ， 并 且 发 送 数据 到 服务 器 ， 
服务 器 会 返回 相应 的 信息 ， 然 后 从 返回 的 信息 中 提取 关注 的 、 有 用 的 信息 。 因 此 ， 这 个 步 又 
也 可 以 称 为 “网 页 数据 抓 取 ”“ 网 抓 ”。 
XMLHTTP 与 Internet Explorer、WebBrowser 有 很 大 的 不 同 ， 主 要 体现 在 以 下 几 个 方面 。 
口 XMLHTTP 没有 任何 界面 、 浏 览 器 。 
口 XMLHTTP 的 特点 是 “发 送 - 接收", 或 者 是 “请 求 ( Request) - 响应 (Response)， 
只 重视 发 出 去 了 什么 ， 得 到 了 什么 ， 并 不 关注 网 页 中 是 如 何 变化 的 ， 网 页 中 有 哪些 
元 素 。 不 像 Internet Explorer 那样 ， 整 个 网 页 操作 流程 都 要 走 一 遍 。 

口 在 网 页 解析 方面 ，XMLHTTP 只 返回 网 页 源 代码 (一 个 很 长 的 字符 串 )， 如 果 要 用 
HTML DOM 解析 ， 还 需要 把 得 到 的 网 页 源 代码 赋 给 HTMLDocument 对 象 。 

口 XMLHTTP 不 能 对 网 页 元 素 进行 操作 。 

使 用 XMLHTTP 的 作用 和 意义 ， 和 暂时 可 以 简单 理解 为 根据 指定 的 url 返回 网 页 源 代码 。 


13.6.1 使 用 XMLHTTP 的 基本 流程 


对 于 访问 不 同 的 网 站 ，XMLHTTP 的 代码 写法 有 所 不 同 ， 但 大 致 流程 如 下 。 

(1 ) 为 工程 添加 “Microsoft XML, v 6.0” 的 引用 。 

(2 ) 创建 XMLHTTP 对 象 。 

(3 ) 使 用 Open 方法 打开 指定 的 url。 

(4) 使 用 SetRequestHeader 设置 请 求 头 (不 是 必需 )。 

(5 ) 使 用 Send 方法 发 送 请 求 。 

(6) 根据 ReadyState 、Status 属性 设置 延 时 等 待 。 

(7 ) 对 服务 器 返回 的 响应 消息 (ResponseBody 、ResponseText 等 ) 进行 分 析 处 理 。 

下 面 的 程序 根据 上 述 流程 ， 使 用 XMLHTTP 打开 一 个 博文 的 网 址 ， 获 取 网 页 源 代 码 。 


Public X As MSXML2 .XMLHTTP60 
Public H As MSHTML.HTMLDocument 
Public SourceCode As String 
Sub GET 请 求 () 

Set X = New XMLHTTP60 

With X 
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.Open bstrMethod:="GET", bstrUrl:="https://www.cnblogs.com/ryueifu-VBA/p 
/9128570.html", varAsync:=False 


-Send 
Do Until .readyState = 4 And .Status = 200 
DoEvents 

Loop 
SourceCode = .responseText 
Debug.Print SourceCode 

End With 

End Sub 


代码 分 析 : XMLHTTP 对 象 的 send 方法 需要 一 定 的 时 间 才 能 把 请 求 发 送 到 服务 器 ， 因 
此 要 在 调用 Send 方法 之 后 加 入 循环 体 进行 延 时 等 待 ， 而 不 能 在 Send 方法 之 后 立即 获取 其 响 
应 消息 。 

运行 上 述 程序 ,立即 窗口 打印 出 该 网 页 的 HTML 源 代码 ， 如 图 13-42 所 示 。 


<!DOCTYPE html> 

Shtml lang="zh-cn”> 

《head》 

Smeta charset= utf-8 /> 

《meta name="viewport” content="width=device-width, initial-scale=1” /> 
Stitle? 代 码 库 - ryueifu -博客 园 (/title》 

《link type="text/¢ss” rel="stylesheet” href="/ /bund}es/blog comon. css?v=-h 


《link id= "MainCss” type="text/css” rel=”stylesheet” href="/skins/C. dingLif 
-style” media=“only ,scrcen and (max-width: 767px)” type="t 
pplication/rsstxm]” rel="alternate” href=“http:// 
application/rsdtxm]l” rel="EditURI” href="http://ww 


i 人 和 type= 
1 
图 13-42 打印 网 页 源 代码 
得 到 网 页 的 源 代码 可 以 用 在 什么 地 方 ， 这 要 根据 具体 的 业务 需求 进行 进一步 的 解析 和 利用 。 
以 上 过 程 是 使 用 XMLHTTP 进行 网 页 请 求 和 响应 的 典型 模板 ， 接 下 来 讲解 各 个 细节 。 


13.6.2 ”判断 是 否 联网 
访问 外 部 网 页 的 前 提 是 计算 机 联网 ， 计 算 机 是 否 联网 也 可 以 用 代码 进行 判断 。 


Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef 
lpdwFlags As Long, ByVal dwReserved As Long) As Long 
Sub 判断 是 否 联网 () 
IfE InternetGetConnectedState (&H0，&H0) = 1 Then 
MsgBox " 已 经 联网 "，vbInformation 


Else 
MsgBox " 断 网 状态 "，vbInformation 
End If 
End Sub 


运行 上 述 程 序 ， 如 果 计 算 机 已 经 联网 ， 则 弹出 “已 经 联网 ”的 提示 对 话 框 。 
13.6.3 GET 和 POST 请 求 


GET 是 向 服务 器 发 索取 数据 的 一 种 请 求 ， 而 POST 是 向 服务 器 提交 数据 的 一 种 请 求 ， 
要 提交 的 数据 位 于 信息 头 后 面 的 实体 中 。 两 者 都 是 向 服务 器 请 求 并 且 获 得 响应 ,使 用 GET 


第 13 章 网 页 自动 化 6 


作为 请 求 方法 时 ，XMLHTTP 对 象 的 Open 方法 中 只 需要 指定 请 求 的 url，Send 方法 不 需要 
发 送 任何 数据 。 使 用 POST 请 求 时 ，XMLHTTP 对 象 的 Open 方法 中 也 需要 指定 请 求 的 url， 
Send 方法 后 面 添加 要 发 送 的 数据 。 

假设 和 是 一 个 XMLHTTP 对 象 ， 使 用 GET 请 求 时 的 基本 语法 格式 如 下 。 


With X 
.Open bstrMethod:="GET", bstrUrl:=" 网 址 "，varRsync:=False 
-Send 

End With 


使 用 POST 请 求 时 的 语法 格式 如 下 。 


With X 
.Open bstrMethod:="POST",， bstrUrl:=" 网 址 "，varRsync:=False 
.Send postdata 

End With 


其 中 ，postdata 是 提交 到 服务 器 的 数据 信息 

在 实际 开发 过 程 中 ， 对 于 一 个 给 定 的 url， 到 底 医用 GET 还 是 用 POST， 一 种 方法 是 根据 
经 验 判断 ， 另 一 种 方法 是 借助 浏览 器 的 开发 工具 来 分 析 请 求 过 程 。 

一 般 情况 下 ， 上 网 的 时 候 在 浏览 器 的 地 址 栏 中 直接 输入 网 址 并 按 回 车 键 ， 网 页 呈现 相应 
的 内 容 ， 这 个 操作 其 实 就 是 一 个 GET 请 求 ， 因 为 除了 输入 网 址 以 外 ， 没 有 提交 其 他 的 数据 
信息 。 

反 过 来 ， 如 果 在 网 页 中 填写 了 一 些 信息 ， 例 如 网 站 、 论 坛 的 登录 实际 上 就 是 把 用 户 名 和 
密码 发 送 到 服务 器 ， 这 个 操作 就 是 一 个 POST 请 求 。 

更 加 可 靠 的 分 析 方法 是 使 用 浏览 器 的 开发 工具 或 者 Fiddler 来 实时 监视 网 络 传输 。 

例如 ， 在 一 个 根据 地 名 查询 邮政 编码 的 网 站 ， 按 下 F12 键 打开 开发 工具 ， 切 换 到 “网 
络 ”选项 卡 ， 并 且 把 左 侧 的 录制 按钮 设置 为 红色 方块 ， 如 图 13-43 所 示 。 


nD i PE TE | 
re cj 5 tnaal 一 mtow “关山 汪 ES 

Ez 坊 剧 ( 引 二 二 (Vv) 起 (A) 工具。 至 动 IH) 
邮政 编码 、 长 放电 话 区 号 专业 在 线 查 询 网 


地 和 查询 印 纺 车 放 查询 
按 此 查看 更 详细 的 者 弓 区 呈 


名 北京 邮编，100000 010 
名 北京 北京 市 邮编 ，100000 区 号 ，010 
更 详细 的 ..…。 


这 
[es 和 x 

es 

rr Fr 一 
= 一 和 


图 13-43 开发 工具 的 “网 络 ” 选 项 卡 
在 地 名 文本 框 中 输入 “苏州 "， 单 击 网 页 中 的 “查询 ”按钮 ， 等 到 页 面 刷新 完毕 后 ,在 
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开发 工具 窗 格 看 到 很 多 记录 ， 这 些 记 录 显 示 在 一 个 列表 中 ， 默 认 处 于 “摘要 ”视图 。 
从 “摘要 ”视图 中 可 以 了 解 到 每 条 请 求 记录 的 url、 请 求 方法 、 结 果 等 信息 ， 如 图 13-44 
所 示 。 


We EEC 
skD5kD6xDr P -5 |‖ 四 raaa — ms x 


区 号 专业 在 线 查 询 网 


[并 


着 


州 市 邮 帝 ，215000 区 


开工 


协 袍 7 
| Com ET 
IT 加 
or mm a 
mr qn a 
wor? a 
a 
or? a 
ou 


Emi 24.50 Ka [25,099 字 ) ER 42123 KB (W31335 字 ) 


图 13-44 每 条 请 求 记录 的 摘要 
选中 一 条 记录 ， 然 后 切换 至 “详细 信息 ”选项 卡 。 可 以 看 到 该 条 记录 的 请 求 方法 是 
GET， 请 求 url 是 http:/www.ip138.com/post/search.asp?area=%CB%D59%D6%0DD&action=are 
a2zip， 如 图 13-45 所 示 。 


Cookie 发 起 程序 计时 


ECEETETETESTITTSTEISTETITIITSTTTGT 全 | 


tezWhtal， pplication/xhtaltrnl, #7* 
Http:/ /wre ip138 eon/post/search asp7ares=yB17B19EEXA9haction 
zhCN 
Worillw/5.0 Oindows WT 6.1; Trident/7.0; rv:11.0) like Gecko 

Aceept-Encoding grip, deflate 

Host 


Connection 
Cookie 


pgr_pvi=9696553856， pev_si=2695397376; bdshare_firstine=1529 


图 13-45 “分 析 请 求 url 


根据 直觉 判断 ，url 中 的 %CB%D5%D6%DD 是 “苏州 ”的 编码 。 

经 过 以 上 分 析 ， 如 果 要 查询 不 同 地 区 的 邮政 编码 ， 只 需要 在 url 中 替换 为 城市 名 称 的 编 
码 即 可 。 

下 面 的 程序 自动 查询 多 个 城市 的 邮政 编码 。 


Sub 邮政 编码 查询 () 


Dim city 


Const TemplateURL As String = "http://www.ipl38.com/post/search.asp?area= 
#1l&action=area2zip™" 
Set X = New XMLHTTP60 
For Each city In Array(" 重庆 "，" 呼和浩特 "，" 昆明 ") 
With X 
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.Open bstrMethod:="Get", bstrUrl:=Replace (TemplateURL，"#1"，URLEncode 
(Cstr (city))), varAsync:=False 
-Send 
Do Until .readyState = 4 And .Status = 200 
DoEvents 

Loop 
SourceCode = VBA.StrConv(.responseBody, vbUnicode, &H804) 
Debug.Print city, SourceCode 

End With 

Next city 
End Sub 


代码 分 析 : 上 述 程序 中 常量 TemplateURL 是 一 个 模板 网 址 ， 只 需要 把 具体 城市 名 称 的 
编码 结果 替换 模板 网 址 中 的 # 旭 占 位 符 即 可 作为 XMLHTTP 的 url。 

由 于 该 网 站 的 编码 是 GB2312， 因 此 获取 源 代码 时 ， 不 能 直接 用 ResponseText， 而 是 用 
StrConv 转换 一 下 。 

运行 上 述 程序 ， 在 立即 窗口 中 打印 出 每 次 查询 的 网 页 源 代码 ， 然 后 利用 字符 串 处 理 方法 
取出 邮政 编码 即 可 ， 如 图 13-46 所 示 。 


ase="subt”>ta href="http://alexa. ip139. com/post/”target=”_blank”) 技 此 查看 更 详细 的 邮 御 区 号 《</a>《/TI 


图 13-46 ”批量 查询 不 同城 市 的 邮政 编码 
以 上 实例 是 XMLHTTP 对 象 的 GET 请 求 的 典型 范例 。POST 请 求 方面 的 应 用 在 13.7 节 
中 进行 讲解 。 


13.6.4 ”正确 获取 网 页 源 代码 


根据 指定 的 网 址 获取 对 应 的 网 页 源 代码 ， 对 网 页 自动 化 、 网 页 数据 获取 的 意义 不 言 而 
喻 。 在 XMLHTTP 的 使 用 过 程 中 ， 当 执行 Send 方法 后 ， 加 入 必要 的 延 时 处 理 ， 就 可 以 获取 
网 页 源 代码 。 

XMLHTTP 对 象 提供 了 ResponseBody、ResponseText 等 属性 。 

ResponseBody 是 一 个 没有 经 过 任何 转换 加 工 的 二 进 制 数据 包 ， 其 中 包含 了 服务 器 返回 
的 所 有 内 容 ， 是 一 个 字 节 数组 。 

ResponseText 是 一 个 字符 串 。 两 者 可 以 进行 相互 转换 。 

其 中 ， 当 网 页 的 编码 是 UTF-8 或 GBK 时 ， 使 用 ResponseText 属性 可 以 得 到 正常 显示 
的 网 页 源 代码 ， 当 网 页 编码 是 GB2312 时 ， 使 用 ResponseText 得 到 的 网 页 源 代码 有 大 量 的 乱 
码 。 出 现 乱码 的 情况 下 ， 不 能 直接 使 用 ResponseText 属性 ， 需 要 把 ResponseBody 按照 网 页 
编码 转换 为 字符 串 。 
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在 获取 源 代码 之 前 ， 可 以 使 用 ADODB 的 Stream 对 象 判断 一 下 ResponseBody 是 不 是 


UTF-8。 


下 面 的 这 个 自 定义 函数 用 来 判断 指定 的 二 进 制 数 组 是 不 是 UTF-8 编码 。 


Public Function IsUTF8(b() As Byte) As Boolean 


Dim i As Long, AscN As Long, 
Length = UBound(b) + 1 
If Length < 3 Then 
IsUTF8 
Exit Function 
ElseIf b(0) 
IsUTF8 
Exit Function 
End If 
Do While i <= Length - 1 
If b(i) < 128 Then 
和 年 十 六 
RscN = AscN+1 
ElseIf (b(i) And &HE0) 
要 二 -条 和 


Length 


False 


&HEF And b(1) 
True 


Elself i + 2 < Length Then 


If (b(i) And &HF0) = &HE0 And 
And &HC0) = &H80 Then 
让 二 :二 于 3 
Else 
IsUTF8 = False 
Exit Function 
End If 
Else 
IsUTF8 = False 
Exit Function 
End If 
Loop 
If AscN = Length Then 
IsUTF8 = False 
Else 
IsUTF8 = True 
End If 


End Function 


&HBB And b(2) 


&HCO And (b(i + 1) And &HCO) 


As Long 


&HBF Then 


&H80 Then 


(b(i + 1) And &HCO) 


&H80 And (b(i + 2) 


在 下 面 的 程序 中 ， 无 论 用 XMLHTTP 访问 哪 一 个 网 址 ， 都 可 以 返回 正常 显示 的 网 页 
源 代码 。 实 现 原理 是 首先 为 工程 添加 ADODB 的 外 部 引用 ,然后 使 用 上 述 ISUTF8 函数 对 


XMLHTTP 对 象 的 ResponseBody 进行 编码 判断 
象 指定 编码 。 


Sub 获取 网 页 源 代码 () 
Dim b() As Byte 
Dim objstream As ADODB.Stream 
Dim SourceCode As String 
Set X = New XMLHTTP60 
With X 


.Open "GET", "http://www.gdchess 


， 判 断 编 码 的 目的 是 给 ADODB.Steam 对 


-Com/"，Ealse 
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-Send 

Do Until .readyState = 4 And .Status = 200 
DoEvents 

Loop 

b = .responseBody ' 赋 给 字 节 数组 

Set objstream = New ADODB.Stream 

With objstream 


.Type = ADODB.adTypeBinary ' 二 进 制 模式 
.Mode = ADODB.adModeReadWrite 
.Open 


-Write Buffer:=b 
-Position = 0 
.Type = adTypeText ' 文本 模式 
If IsUTF8 (b) Then 
.Charset = "utf-8" 
Else 
.Charset = "GB2312" 
End If 
SourceCode = .ReadText ' 返回 文本 
Debug.Print SourceCode 
.Close 
End With 
End With 
End Sub 


可 以 尝试 各 种 网 址 ， 运 行 上 述 程 序 后 ， 在 立即 窗口 均 能 正确 返回 网 页 源 代码 。 得 到 网 页 
源 代码 后 ， 可 以 使 用 VBA 的 字符 串 处 理 、 正 则 表达 式 来 提取 其 中 有 用 的 内 容 ， 也 可 以 把 网 
页 源 代码 赋 给 HIMLDocument 对 象 ， 使 用 HIML DOM 进行 分 析 。 


13.6.5 “网 页 中 文件 的 下 载 


在 网 页 自动 化 方面 ， 经 常 需要 从 一 个 网 站 批量 下 载 网 页 中 超 链接 指向 的 文件 ， 网 页 上 的 
文件 一 般 是 一 个 超 链接 a 元 素 。 文 件 的 实际 url 显示 在 a 元 素 的 href 属性 中 。 

XMLHTTP 对 象 的 Open 方法 ， 除 了 可 以 打开 一 般 的 网 址 ， 也 可 以 直接 指定 一 个 文件 的 
地 址 。 当 用 XMLHTTP 请 求 文件 时 ， 返 回 的 二 进 制 数据 ResponseBody 就 是 这 个 文件 本 身 ， 
保存 为 本 地 文件 即 可 实现 文件 下 载 。 

例如 ， 压 缩 文件 WinRAR 的 主页 有 很 多 安装 程序 的 下 载 地 址 ， 如 果 要 下 载 该 页 面 显示 
的 所 有 文件 ， 首 先 要 获取 该 页 面 上 所 有 的 超 链接 。 获 取 到 超 链接 后 ， 依 次 下 载 每 一 个 文件 。 

事先 使 用 浏览 器 的 开发 工具 检查 其 中 一 个 超 链 接 ， 可 以 看 到 超 链 接 的 href 是 一 个 相对 
地 址 ， 如 图 13-47 所 示 。 

必须 使 用 绝对 地 址 才能 下 载 ， 因 此 需要 把 该 href 与 网 站 主页 地 址 拼接 为 : https://www. 


rarlab.com/rar/wrarS6bStc.exe, 


Public X As MSXML2 .XMLHTTP60 
Public H As MSHTML .HTMLDocument 
Public SourceCode Rs String 
Sub 解析 网 页 内 容 () 


Dim FileLink As MSHTML .HTMLRAnchorElement 
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Set X = New XMLHTTP60 
With XxX 


="https://www.rarlab.com/", varAsync:= 


" 把 网 页 源 代 码 赋 给 HTMLDocument 文档 


.Open bstrMethod:="Get"，bstrUrl: 
False 
-Send 
Do Until .readyState = 4 And .Status = 200 
DoEvents 
Loop 
SourceCode = .responseText 
End With 
Set H = New MSHTML.HTMLDocument 
H.body.innerHTML = SourceCode 
For Each FileLink In H.getElementsByTagName ("a") 
If FileLink.href Like "*.exe" And FileLink.innerText = "32 bit" Then 
Debug .Print FileLink.href, FileLink.innerText 
End If 
Next FileLink 
End Sub 
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图 13-47 


超 链接 中 的 相对 路 径 


代码 分 析 : 由 于 主页 上 的 超 链接 a 元 素 均 没有 id 属 性 ， 因 此 使 用 getElementsByTag 


Name("a") 获取 页 面 上 的 所 有 超 链接 ， 为 了 避免 
遍历 到 广告 或 者 其 他 没 用 的 超 链接 ， 可 以 使 用 下 
语句 进行 过 滤 ， 只 有 以 .exe 结尾 的 超 链接 且 文 
本 内 容 是 32 bit 的 才 遍 历 到 。 

运行 上 述 程序 ， 在 立即 窗口 打印 出 32 位 安 
装 程序 的 超 链接 地 址 ， 如 图 13-48 所 示 。 

这 里 假定 要 下 载 第 3 个 文件 。 下面 的 程 
序 中 , XMLHTTP 的 ul 设置 为 文件 的 绝对 路 
径 ， 发 送 请 求 后 ， 把 ResponseBody 保存 为 本 地 
文件 。 


| 
about:/rar/wrar560b5ar. exe 32 bit 
about:/rar/wrar560b5am. exe 32 bit 
about:/rar/wrar56b5tc. exe 32 bit 
about:/rar/wrar560b5nl. exe 32 bit 
about:/rar/wrar56b5. exe 32 bit 
about:/rar/wrar560b5fr. exe 32 bit 
about:/rar/wrar56b5d. exe 32 bit 
about:/rar/wrar56b5hu. exe “32 bit 
about:/rar/wrar560b5id. exe 32 bit 
about:/rar/wrar560b51t. exe 32 bit 
about:/rar/wrar560b5pt. exe 32 bit 
4| | 


图 13-48 遍历 网 页 中 扩展 名 为 .exe 的 
文件 地 址 
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Sub 下 载 文件 () 


DownLoadFile url:="https://www.rarlab.com/" & Replace("about:/rar/wrar56b5tc. 
exe"，"about:/"，"")，LocalName:="WinRAR 32 位 中 文 版 .exe" 
End Sub 
Sub DownLoadFile(url As String, LocalName As String) 
Dim b() As Byte 
Set X = New XMLHTTP60 
With X 
-Open "GET", url, False 
.send 
Do Until .readyState = 4 And .Status = 200 
DoEvents 
Loop 
b = .responseBody 
Dim FileNum Rs Long 
FileNum = FreeFile 
Open ThisWorkbook.Path & "\" & LocalName For Binary Access Write As #FileNum 
Put #FileNum, , b 
Close #FileNum 
End With 
End Sub 


运行 上 述 程 序 ， 在 工作 簿 路径 下 多 了 一 个 文件 ， 如 图 13-49 所 示 。 


名称 修改 日 其 类 型 大 小 
| 柄 winrar 32 位 中 文 版 exe 。 “2018/6/18 13:00 ”应 用 程序 3,140 KB| 
和 6 实例 文档 95.xlsm 2018/6/18 11:00 ”Microsoft Excel .. 21 KB 


图 13-49 根据 文件 的 url 下 载 文件 到 本 地 计算 机 
以 上 程序 的 源 代码 文件 为 “实例 文档 95.xlsm”。 


13.6.6 ”使 用 API 函数 下 载 文件 
如 果 知 道 网 络 文件 的 url， 也 可 以 使 用 API 函数 下 载 文件 到 本 地 计算 机 。 


Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownload 
ToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, 
ByVal dwReserved As Long, ByVal lpfnCB Rs Long) As Long 

Public Sub 下 载 文 件 () 


Dim r As Long 
r = URLDownloadToFile(0, "https://files.cnblogs.com/files/ryueifu- 
VBA/SEA4%BBSA3%E7%AO0%81%E5%$BAS93.rar", ThisWorkbook.path & "\Temp.rar", 0, 0) 

If r = 0 Then 
MsgBox "下 载 成 功 ! " 

Else 
MsgBox " 下 载 失 败 ! " 

End If 

End Sub 


运行 上 述 程序 ,在 工作 短路 径 下 产生 一 个 Temp.rar 压缩 包 文件 。 
以 上 程序 的 源 代码 文件 为 “实例 文档 96.xlsm”。 
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13.7 WinHttp 


Microsoft Windows HTTP 服务 ( WinHttp) 为 开发 人 员 提 供 了 HTTP 客户 端 应 用 程序 编 
程 接口 (API)， 通 过 HTTP 协议 向 其 他 HTTP 服务 器 发 送 请 求 。 

使 用 WinHttp 也 可 以 实现 网 页 数据 的 发 送 和 获取 ，WinHttp 对 象 的 属性 、 方 法 与 
XMLHTTP 大 部 分 相同 ， 本 节 介 绍 使 用 WinHttp 向 网 站 服务 器 发 送 数据 、 获 取 服 务 器 返回 数 
据 的 方法 。 

平时 上 网 的 过 程 中 ， 经 常 需 要 从 网 站 上 进行 查询 、 转 换 、 计 算 ， 或 者 提交 注册 信息 、 发 
表 博 客 、 论 坛 账号 登录 ， 而 不 是 简 简单 单 通过 url 打开 一 个 网 页 查看 内 容 。 尤 其 是 访问 一 些 
需要 登录 的 网 站 ， 登 录 前 后 能 够 访问 的 范围 有 很 明显 的 差别 。 


本 节 使 用 WinHttp 自动 向 网 站 提交 账户 信息 ， 登 录 成 功 后 进一步 访问 网 站 中 的 其 他 页 面 
的 信息 。 


13.7.1 POST 请 求 和 响应 


VBA 中 使 用 WinHttp 对 象 ， 首 先 需要 添加 对 “Microsoft WinHTTP Services, version 5.1” 
的 外 部 引用 ， 如 图 13-50 所 示 。 


引用 -VBAProject 一 

本 人 的 8 用 0); [本 
MVisual Basic For Applications 取消 

Microsoft Excel 15.0 Object Library 
MOLE Automation 各 -一 一 
Mi rooft Office 15.0 Object Libra 浏览 8)... 

| [li crosoft YinHTTP Services, versio 
Mcrosoft Seript Control 1.0 全 

| | 四 mieroseft HTML Object Library 
DMicrosoft Visual Basic for Applica 优先 级 

| IMicrosoft XNL, ve 帮助 00 

| IO YBAProject 

| 


DWindows Script Host Object Model 

口 AeeessibilityCplAdnin 1.0 Type Lib 
口 AceountProtect 1.0 Type Library > 
Ddcrahet 

< 上 


Microsoft WinHTTPF Services, version 5.1 


定位 :CC: MWindows\systen32\winhttp. dl 
| 语言 : 标准 


图 13-50 ”添加 外 部 引用 


发 送 POST 请 求 的 过 程 ， 就 是 向 网 站 提交 数据 的 过 程 ， 可 以 分 为 请 求 ( Request) 和 响应 
(Response) 两 大 部 分 ,请求 和 响应 往往 是 有 对 应 关系 的 ， 根 据 提交 的 信息 ， 服 务 器 做 出 相应 
的 回答 。 

请 求 部 分 需要 提供 如 下 三 部 分 内 容 。 

口 请求 url: POST 请 求 的 网 址 。 

口 请 求 头 (RequestHeader) : 是 请 求 报 文 特有 的 ， 它 们 为 服务 器 提供 了 一 些 额 外 信息 ， 

例如 客户 端 希望 接收 什么 类 型 的 数据 。 
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口 请求 正文 (RequestBody) : 向 服务 器 发 送 的 数据 ， 如 果 是 登录 网 站 ,用 户 名 和 密码 往 
往 要 包含 在 请 求 正文 中 。 
请 求 发 送 后 ， 服 务 器 返回 的 响应 消息 部 分 如 下 。 
口 响应 头 ( ResponseHeader) : 响应 头 向 客户 端 提供 一 些 额外 信息 ， 例 如 谁 在 发 送 响应 、 
响应 者 的 功能 ， 甚 至 与 响应 相关 的 一 些 特 殊 指 令 。 这 些 头 部 有 助 于 客户 端 处 理 响应 ， 
并 在 将 来 发 起 更 好 的 请 求 。 
口 响应 正文 (ResponseBody): 是 服务 器 返回 的 资源 的 内 容 。 
在 使 用 WinHttp 发 送 POST 请 求 时 ， 请 求 部 分 的 代码 编写 ， 需 要 事先 手工 在 网 页 上 操 
作 ， 利 用 浏览 器 开发 工具 的 “网 络 ” 选 项 卡 ， 录 制 请 求 和 响应 过 程 。 


13.7.2，” 抓 包 分 析 

在 手工 操作 网 页 的 过 程 中 ， 按 F2 键 打开 浏览 器 的 开发 工具 F12， 切 换 至 “网 络 ”选项 
卡 ， 并 且 把 左 侧 的 “开始 录制 ”按钮 切换 为 红色 方块 。 当 网 页 上 发 生 请 求 行为 时 ， 开 发 工具 
窗 格 会 自动 记录 每 次 请 求 的 详细 信息 。 

此 处 以 登录 网 站 并 且 查 看 个 人 资料 为 例 ， 逐 步 讲解 WinHttp 的 实现 过 程 。 

首先 在 浏览 器 中 打开 账户 登录 的 网 页 ， 输 入 用 户 名 和 密码 之 后 ， 再 打开 开发 工具 ， 并 设 
和 为 录制 状态 ， 如 图 13-51 所 示 。 


一 TREE 
=. = Pp-x| Osicrontsn sow | 
Er 
51CT0.com 
技术 成 就 梦想 
登录 51CTO Bren | i 


三 moenu 


| = .-- 


2 ES ES 


图 13-51 录制 请 求 过 程 
然后 单 击 “ 登 录 ” 按 钮 ， 成 功 登 录 网 站 ,并 且 在 开发 工具 窗 格 看 到 多 了 很 多 条 请 求 记 
录 ， 定 位 到 方法 为 “POST” 的 那 条 记录 ， 如 图 13-52 所 示 。 
然后 从 “摘要 ”页 切换 至 “详细 信息 ”页 ,或 者 直接 双击 请 求 记录 ,打开 该 条 请 
求 的 详细 页 面 。 “详细 信息 ”中 又 分 为 “请 求 标 头 " “请求 正文 “响应 标 头 “响应 正文 ” 
等 选项 卡 。 
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EL 协议 方法 “结果 类 型 已 的 疏 。 已 花费 发 起 程序 
Ihttps://logserver. Sleto. com/log s... HITFS SET 200 text/htal 9B 059s Cing> 
Ihttps://logserver. Sleto. con/log_s... HTTFS SET 200 text/htal 179B 056s Cine 

200 
/canter/user/index/login-success?... JITP GET 302 textfhtml 463 B 141 ns 号 航 
[http://edu Sleto. com/center/wejob... HITP GET 200 text/htal 33.47 开 156 ms 导航 
Ihttps://staticl. Sleto. com/edu/cen. .. HITFS GET 。 200 text/ess 20.83 IB 62ns ~ ink rel=" 
[https://staticl. Sleto, eon/edu/cen. .. HITFS GET 20 text/ess L501B Afns dinkrel=" 
Ihttps://staticl. Sleto. com/edu/cen. .. HITFS GET 200 spplicationx-... 92.23 WB G3ns Cscript> 
陪 E J/staticl. Sleto. con/edu/cen. .. HTTFS GET 200 spplicatio/x-... 1.50IB B62ms Cseript> 

4 器 

区 目 : 112 已 发 送 : 252.42 KB (258,478 字 五 ) 已 接收 1.78 MB (1.867.091 地 节 ) 


图 13-52 ”找到 对 应 于 登录 过 程 的 那 条 请 求 


在 “请 求 标 头 ”中 ， 可 以 获取 到 POST 请 求 的 url、 请 求 标 头 。 比 较 重 要 的 请 求 头 有 : 
Referer、Content-Type 、Cookie 等 ， 如 图 13-53 所 示 。 


M 


mm 四国 六 如 兰 X P 


接 要 详细 信息 《4 3/112 上 http://home.51cto,com/index/?reback=http%3A%2F%2Fedu.51cto.com%2Fcent 
博 求 标 头 请 求 正文 响应 标 头 有 响应 正文 Cookie 发 起 程序 计时 


Vindex/?rebackchttBpXSAXZ 


|Aeeept html, epplication/xhtaltxnl, 

[Referer http://home. Sleto. con/index/Treback=http%3AX2FXoFedu Sleto. conX2F centerXoPuserX2FindexN2Flogin. 
Accept-Languaee hrCN 

|user-Agent Werilla/5.0 Mindows NT 6.1; Trident/7.0; rv:11,0) like Gecko 

[Content-Type application/x-mm- forn-urlencoded 

IAccept-Encoding erip, deflate 

jost home Sleto. com 

[Content-Length 193 

ce on Keep-Alive 

[Cache-Control che 

[Cookie ourplusFirstTine=118-6-9-19-13-46; _ourplusReturnTine=118-6-18-21-58-46; _ourplusReturnCount= 


图 13-53 一 条 请 求 的 详细 信息 
“请 求 正文 ”中 ， 可 以 看 到 登录 网 站 过 程 中 提交 到 网 站 服务 器 的 数据 ， 这 些 数据 以 “ 键 
值 对 ”的 形式 提交 给 服务 器 ， 键 和 值 之 间 用 = 连接， 每 个 键 值 对 之 间 用 & 隔 开 。 
具体 书写 形式 类 似 于 : user=ryueifu&password=123456&other=...， 如 果 请 求 正文 中 包含 
中 文 或 其 他 符号 ， 还 需要 进行 编码 ， 如 图 13-54 所 示 。 


@ 英名 | 国名 x P 
所 要 话 细 信息 。 4。 3/113 。 httpy//homeSlctocom/index/?reback=http%3A%2F%2Fedu'51cto.com%2Fcenter%| 
请 求 标 头 。 。 请求 正 文 。。 响应 标 头 。 响应 下 文 。。 Cookie 。 ”发 起 得 序 。 计时 

1 | _esr f=YoxEONYPb MEXHeTHywF BMSTE AeC DFHAMSGD eR2 Np HF AVIEz EP IAD Bos er nm ol-r yor Fal np or on5T] 


图 13-54 请求 正 文 
一 般 来 说 ， 获 取 到 请 求 url 、 请 求 标 头 、 请 求 正 文 这 3 项 ， 就 可 以 动手 写 代 码 了 。 
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顺便 了 解 一 下 “响应 标 头 ”， 实 际 上 无 论 是 手工 在 页 面 中 操作 ， 还 是 用 程序 自动 操作 ， 
返回 的 “响应 标 头 ”应 该 是 一 致 的 。 
响应 标 头 也 是 一 些 键 值 对 ， 在 开发 工具 中 显示 为 表格 形式 ， 如 图 13-55 所 示 。 


CIRIEIESEE P| 


搞 要 详细 信息 4 3/113 ls http://home.51cto.com/index/?reback=http%3A%2F9%2Fed| 
请 求 标 头 请 求 正文 响应 标 头 响应 正文 Cookie 发 把 程序 计时 
键 值 
Date Non, 18 Jun 2018 13:58:59 GNT 
Content-Type text/htnl; charset=UTF-8 
Transfer-Encoding chunked 
Connection keep-alive 
Server nginx 
PaPp CP="CURs ADla DEVa PSAo PSDo OUR BUS UNT PUR INT DEM STA PRE 
Expires Thu, 19 Nov 1981 08:52:00 GHT 
Cache-Control no-store, no-cache, must-revalidate, post-check=0, pre-check=0 
Pragna no-cache 
Set-Cookie PHPSESSID=2ntc4t£u317s6qs0oaktnl80cT: path=/; HttpOnly 
Set-Cookie pub_sid-deleted; expires=Thu, O01-Jan-1970 00:00:01 GHT; Max-A. 
Set-Cookie pub_sauthl=Ex1MAQwDQnsFAeUCYApVPQUGB11YAQUCUVo; path=/; domai 
Set-Cookie pub_sauth2=80417421d791dbe44bfcc31Sfelbbf9a; path=/; donain= 
Set-Cookie pub_cookietime=0; path=/; domain=.Sleto. con; httponly 
refresh DO:wl=http://edu Sleto. com/center/user/index/login- success?si 


图 13-55 ”响应 标 头 
通过 响应 标 头 往往 可 以 看 出 请 求 的 结果 、 登 录 是 否 成 功 等 信息 。 


注意 其 他 种 类 的 浏览 器 ， 开 发 工具 的 外 观 设 计 有 所 不 同 ， 但 是 录制 出 的 内 容 基本 一 样 。 


13.7.3 ”构建 代码 


利用 浏览 器 的 开发 工具 的 抓 包 分 析 得 到 的 数据 ， 内 容 往往 比较 长 ， 不 太 适 合 直接 写 在 
VBA 代码 中 ， 实 际 开 发 过 程 中 ， 可 以 把 这 些 参数 存储 于 文本 文件 或 Excel 单元 格 中 。 

例如 单元 格 B2 存储 POST 请 求 的 URL，B3-B5 存储 请 求 标 头 ，B6 存储 请 求 正 文 ， 如 
图 13-56 所 示 。 


日 5 en Da rel 


本 


图 13-56 使 用 单元 格 存储 参数 


为 了 能 让 WinHttp 对 象 在 账号 登录 之 后 ， 在 其 他 过 程 中 继续 访问 网 站 中 的 其 他 网 页 ， 要 
把 该 对 象 声 明 为 Public。 
下 面 的 程序 自动 登录 网 站 ,并 且 在 立即 窗口 打印 响应 标 头 信息 。 


Public W As WinHttp.WinHttpRequest 


4 琐 office VBA 开发 经 典 一 中 级 进 阶 郑 


Sub 账号 登录 () 
Set W = New WinHttp.WinHttpRequest 
With W 


.Open Method:="POST", URL:=Range("B2") .Value, Async:=False 
.SetRequestHeader "Referer", Range("B3") .Value 
.SetRequestHeader "Content-Type", Range("B4") .Value 
.SetRequestHeader "Cookie", Range("B5") .Value 
.Send body:=Range ("B6") .Value 
Debug.Print .GetAllResponseHeaders 
Debug.Print .GetResponseHeader (Header:="Content-Type") 
End With 
End Sub 


运行 上 述 程序 ， 在 立即 窗口 打印 出 了 所 有 响应 标 头 ， 如 图 13-57 所 示 。 


Date: Tue，19 Jun 2018 14:16:24 GMT 
Pragma: no-cache 

Transfer-Encoding: chunked 
Content-Type: text/html; charset=UIF-8 
Expires: Thu, 19 Nov 1981 08:52:00 


GMT 
P3P: CP="CURa ADMa DEVa PSAo PSDo OUR BUS UNI PUR INT DEM STA PRE COM NAV OTC NOI DSP COR 
Server: nginx 
Set-Cookie: PHPSESSID=00ggepltm6obp27r9d088i7796; path=/; HttpOnly 
Set-Cookie: pub_sid-deleted, expires=Thu, 01-Jan-1970 00:00:01 GMT; Max-Age= 0; Pathe/; do 
Set-Cookie: pub_sauth1=ExlMAQwDQqmsFAgUCVApVPQUGB11SAwIGWle，pa ). 
Set-Cookie: pub_sauth2=9clfdf1d408047b4eeac8b729358ba70，pat min te com; httpo 
Set-Cookie: pub_cookietime=0; path=/; domain=.5lcto. com; httpoi 
Sot-Cookie: "identitysdelered, expires:Thu, O01- Jan 1970 00:082 a YGar; Mer-Age=0; path= 


图 13-57 自动 发 送 请 求 并 打印 响应 标 头 


将 这 些 响 应 标 头 与 抓 包 分 析 得 到 的 响应 标 头 对 比 ， 可 以 发 现 两 者 基本 一 致 ， 说 明 登 录 
成 功 。 
么 提交 错误 的 用 户 名 或 密码 ， 结 果 会 怎样 呢 ? 假设 故意 写 错 用 户 名 或 密码 ， 再 次 运行 
上 述 程序 ， 会 发 现 少 了 很 多 响应 标 头 ， 尤 其 缺少 了 Set-Cookie 响应 标 头 ， 如 图 13-58 所 示 。 


Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0 
Connection: keep-alive 

Date: Tue, 19 Jun 2018 14:28:47 GMT 

Pragma: no-cache 

Transfer-Encoding; chunked 

Content-Type: text/html; charset=UTF-8 


Expires: Thu, 19 Nov 1981 08:52:00 GMT 

P3P: CP="CURa ADMa DEVa PSAo PSDo OUR BUS UNI PUR INT DEM STA PRE COM NAV OTC NOI DSP COR 
Server: nginx a 

Vary: Accept-Encoding 没 登录 成 功 

Load-Balancing: webll. hb2 


text/html; charset=UIF-8 


图 13-58 使 用 错误 的 账号 信息 所 返回 的 响应 标 头 


13.7.4 ”继续 访问 网 站 其 他 网 页 


由 于 声明 的 WinHttp 是 一 个 模块 级 公有 变量 ， 当 登录 过 程 结束 后 ， 该 变量 依然 保留 着 登 
录 状 态 的 信息 ， 因 此 可 以 使 用 它 继续 访问 同一 网 站 的 其 他 网 页 。 


Sub 访问 个 人 主页 () 
Dim H Rs MSHTML.HTMLDocument 
Dim MyInformation As MSHTML.HTMLDivElement 
With W 
.Open Method:="GET", URL:="http://edu.5lcto.com/center/course/lecturer/ 
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course", Async:=False 


-Send 
Set H = New MSHTML.HTMLDocument 
H.body.innerHTML = .ResponseText 


Set MyInformation = H.getElementsByClassName ("user Top") .Item(0) 
Debug.Print MyInformation.innerText 


End With 
End Sub 
运行 上 述 过 程 ， 立 即 窗口 打印 出 讲师 的 个 人 信息 ， 如 图 13-59 所 示 。 
WD 
刘 永 言 
中 级 讲师 


学 员 总 数 : 56637 人 
好 评 率 : 83% 
公告 


周年 庆 预 热 活动 开始 推广 啦 ! 想 要 钱包 鼓 鼓 请 看 详细 策略 ! 2018-06-05 


图 13-59 在 登录 状态 下 访问 其 他 网 页 
以 上 程序 的 源 代码 文件 为 “实例 文档 97.xlsm”。 


13.8 ”本 章 小 结 


HTMLDOcument 可 以 把 一 个 字符 串 形 成 HTML 对 象 模 型 ， 从 而 对 网 页 中 的 元 素 进 行 获 
取 、 操 作 、 编 辑 等 操作 。 

Internet Explorer 和 WebBrowser 是 实际 的 浏览 器 对 象 ， 使 用 VBA 代码 可 以 代替 鼠标 和 
键盘 ， 自 动 操作 网 页 。 

XMLHTTP、WinHttp 二 者 和 浏览 器 、 网 页 无 关 ， 这 两 个 对 象 需要 的 原料 是 网 址 、 请 求 
标 头 、 发 送 的 数据 ， 执 行 Send 方法 以 后 ,返回 的 是 响应 标 头 、ResponseBody 等 。 


其 他 常见 话题 全 


编程 开发 过 程 中 ， 经 常会 用 到 随机 数 、 进 制 转换 、 颜 色 的 获取 和 设置 、 日 期 和 时 间 的 表 
达 及 转换 等 知识 。 


14.1 随机 数 


VBA 中 使 用 Randomize 语句 初始 化 随机 数 生成 器 种 子 ，Rnd0 可 以 产生 一 个 介 于 0 和 1 
之 间 的 随机 小 数 。 


Sub Testl1() 
Dim number As Double 


Randomize ' 初始 化 随机 数 生 成 器 来 产生 种 子 
number = Rnd() "0 到 1 之 间 的 小 数 
Debug.Print number 

End Sub 


多 次 运行 上 述 过 程 ， 每 次 打印 的 结果 均 不 一 样 。 

由 于 0 < Rnd0 < 1, 假设 有 一 个 正 整数 n， 可 以 推出 : 
0<n*Rnd() <n 

进一步 推出 : CIntn*Rnd()) 是 一 个 介 于 0 和 mn 之 间 的 随机 整数 。 
例如 ，3 + CInt((7 -3)* Rnd0) 会 产生 3 到 7 之 间 的 随机 整数 。 


14.2 ” 进 制 
VBA 编程 中 支持 八进制 和 十 六 进 制 ， 八 进 制 常量 用 &o 作为 前 级 ， 十 六 进 制 常量 用 
&H 作为 前 级 。 


Oct 函数 用 于 把 其 他 数字 转换 为 八进制 字符 串 ，Hex 函数 用 于 把 其 他 数字 转换 为 十 六 进 
制 字符 串 。 


Sub 八进制 和 十 六 进 制 () 


Dim b As Integer，C As Integer 


b = &023 
c= &H31 
Debug.Print b, c " 自动 转换 为 十 进 制 数 
Debug.Print Oct(b), Hex(c) " 显示 为 八进制 、 十 六 进 制 字符 串 
End Sub 
运行 上 述 程 序 ， 打 印 结果 如 下 。 
19 49 
23 31 


其 中 ,19 是 八进制 数 23 转换 为 十 进 制 的 结果 ,49 是 十 六 进 制 数 31 转换 为 十 进 制 的 结果 。 
因此 ，&023 与 19 是 等 价 的 ，&H31 与 49 是 等 价 的 ，&HFF 与 255 也 是 等 价 的 。 


14.3 ”颜色 


在 编程 过 程 中 ， 经 常会 获取 或 设置 对 象 的 颜色 ， 例 如 设置 单元 格 的 填充 色 。 在 Excel 
VBA 中 可 以 通过 设置 Color 或 ColorIndex 属性 来 设置 颜色 。 

Color 属性 的 取 值 可 以 是 VBA 中 颜色 常数 之 一 ， 也 可 以 使 用 RGB 函数 来 设置 。 例 如 下 
面 两 行 代码 的 作用 相同 ， 都 是 把 单元 格 填充 色 变 为 红色 。 


Range ("Al1") .Interior.Color = VBA.ColorConstants.vbRed 
Range ("B1") .Interior.Color = RGB(255, 0, 0) 


也 就 是 说 ，vbRed 和 RGB(255, 0. 0) 以 及 RGB(&HFF, 0, 0) 是 完全 相等 的 。 
实际 上 ， 颜 色 是 用 三 原色 来 描述 的 ， 也 就 是 R、G、B 混合 起 来 的 ， 每 个 分 量 的 最 小 值 
是 0， 最 大 值 是 &HFF ( 255 )。 
假设 有 一 种 颜色 的 R、G、B 的 比例 是 5:3:2， 那 么 换 成 十 进 制 是 255:153:102， 表 示 为 
六 进 制 是 &HFF、&H99、&H66， 以 下 两 行 代码 均 可 在 单元 格 中 看 到 这 种 颜色 的 实际 效果 。 
Range ("R1") .Interior.Color = &H6699FF 
Range ("B1") .Interior.Color = RGB(&HFF, &H99, &H66) 
另外 ，Excel VBA 还 可 以 使 用 ColorIndex 来 表示 颜色 ，ColorIndex 从 1 到 56 代表 56 种 
不 同 的 颜色 。 
为 了 查看 所 有 ColorIndex 的 效果 ， 可 以 用 如 下 的 循环 把 每 一 个 单元 格 填充 不 同 的 颜色 。 
Sub Test3 () 
Dim i As Integer 
For i=1 To 56 
Range ("A" & i) .Interior.ColorIndex = i 


Next i 
End Sub 


以 上 程序 的 源 代码 文件 为 “实例 文档 99.xlsm”。 
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14.4 ”Excel 的 文件 格式 


Excel 2007 以 下 文件 〈 低 版 本 文件 ) 的 扩展 名 是 .xls， 这 种 格式 的 工作 表 最 后 一 行 的 行 
号 是 65536 ( 256" )， 最 右 一 列 的 列 标 字 母 是 IV (第 256 列 )。 因 此 工作 表 最 右 下 角 的 单元 格 
地 址 是 IV65536。 

Excel 2007 以 上 文件 (高 版 本 文件 ) 的 扩展 名 是 4 位 英文 字母 ， 例 如 .xlsx、.xlsm 等 。 
这 种 文件 的 工作 表 最 后 一 行 的 行 号 是 1048576( 1024? )， 最 右 一 列 的 列 标 字 母 是 XFD( 128? )， 
最 石 下 角 的 单元 格 地 址 是 XFD1048576。 

但 是 , 文件 的 格式 和 Excel 的 版 本 又 是 两 回 事 ， 即 使 Excel 2013 中 也 支持 低 版 本 的 
Excel 文件 ， 也 就 是 说 在 Excel 2013 中 打开 扩展 名 为 .xls 的 工作 短 ， 最 右 下 角 的 单元 格 依然 
是 IV65536。 编 程 过 程 中 ， 把 数组 赋 给 单元 格 的 时 候 ， 或 者 使 用 Range.CopyFromRecordset 
方法 把 结果 记录 集 粘贴 到 单元 格 ， 必 须 考 虑 单元 格 区 域 能 否 容纳 这 些 数 据 。 

下 面 的 程序 用 来 判断 当前 工作 德 的 文件 类 型 。 

Sub 判断 工作 簿 类 型 () 

Dim fmt As Excel.XlFileFormat 

fmt = ActiveWorkbook.FileFormat 

If fmt = Excel.XlFileFormat.xlExcel8 Then 
Debug.Print " 当前 工作 簿 是 Excel2003 文件 " 

ElselIf fmt = Excel.XlFileFormat.xlOpenXMLWorkbook Then 
Debug .Print " 当前 工作 簿 是 .x1sx 文件" 

ElselIf fmt = Excel.XlFileFormat.xlOpenXMLWorkbookMacroEnabled Then 
Debug .Print " 当前 工作 簿 是 .xlsm 文 件 " 


End If 
End Sub 


众所周知 ， 在 Excel 中 按 下 快捷 键 【 CtrltN ] 快速 新 建 一 个 工作 短 Book1， 那 么 这 个 新 
建 的 而 且 尚 未 保存 的 工作 敌 是 什么 格式 ?这 取决 于 Excel 应 用 程序 对 默认 文件 格式 的 设置 ， 
如 图 14-1 所 示 。 
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图 14-1 “Excel 选项 ”对 话 框 


所 示 。 运行 时 江油 “1004 : 
出 错 的 原因 是 ， 低 版 本 文件 不 存在 七 万 行 、 | 

一 千 列 。 | 
如 果 把 Application.DefaultSaveFormat 修改 为 ”| sf 3 ho | 


Excel.XIFileFormat xlOpenXMLWorkbook， 再 次 运 
行 上 述 程序 ， 不 会 出 错 。 


如 果 默 认 文 件 格式 设置 为 .xls 格式， 那么 新 建 的 工作 短 就 是 低 版 本 文件 。 
Application. DefaultSaveFormat 用 来 读 写 Excel 默认 的 文件 格式 。 
下 面 的 程序 ， 首 先 把 Excel 默认 文件 格式 设置 为 低 版 本 文件 格式 ， 然 后 新 建 一 个 工作 


， 并 且 试 图 把 一 个 二 维 数组 赋 给 单元 格 区 域 。 


Sub 创建 低 版 本 的 Excel 文件 () 
Dim wbk As Excel.Workbook, wst As Excel.Worksheet 
Dim arr(1 To 70000,1 To 300) As Integer 
Application.DefaultSaveFormat = Excel .XlFileFormat.xlExcel8 
Set wbk = Application.Workbooks.Add 
Set wst = wbk.Worksheets (1) 
wst.Range ("Al") .Resize(70000, 300) .Value = arr 

End Sub 


运行 上 述 程序 ， 出 现 运 行 时 错误 ， 如 图 14-2 。 Mieresor Visual Base 


图 14-2 行列 超出 工作 表 范围 


14.5 日 期 和 时 间 运 算 


在 VBA 中 ,日 期 和 时 间 是 一 种 介 于 数字 和 字符 串 之 间 的 数据 类 型 ， 在 实际 编程 过 程 


， 遇 到 日 期 时 间 处 理 的 场合 非常 多 。 


日 期 时 间 的 数据 类 型 是 Date， 日 期 时 间 常 量 两 边 用 # 括 起 来 。 
内 置 函 数 Now、Date 、Time 分 别 返 回 当前 日 期 和 时 间 、 当 前 日 期 、 当 前 时 间 。 


14.5.1 分 量 的 提取 


回 一 


VBA 的 内 置 函数 Year、Month、Day、Hour、Minute 、Second 用 于 提取 每 个 分 量 ， 均 返 
个 整数 。 
下 面 的 程序 打印 一 个 日 期 的 年 月 日 、 时 分 秒 。 


Sub 分 量 的 提取 () 

Dim dt As Date 

dt = #8/8/2008 9:15:37 AM# 

Debug.Print Yearl(dt), Month(dt), Dayl(dt), Hour(dt), Minute(dt), Second(dt) 
End sub 


14.5.2 “日 期 和 时 间 的 生成 


用 于 生成 日 期 、 时 间 的 VBA 函数 如 下 。 
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口 DateSerial: 由 年 月 日 三 个 分 量 合 成 日 期 。 
口 TimeSerial: 由 时 分 秒 三 个 分 量 合成 时 间 。 
口 CDate: 可 以 把 日 期 时 间 字 符 串 、 整 数 转换 为 日 期 时 间 。 
Sub 日 期 和 时 间 的 生成 () 
Debug.Print DateSerial(2015，7，8) 
Debug.Print TimeSerial(20，17，8) 
Debug.Print CDate("2015，7，8")，CDate("2015 年 7 月 8 日 15 时 30 分 ") 


Debug.Print CDate (20150) 
End Sub 


代码 分 析 : CDate 是 一 个 功能 强大 的 转换 函数 ， 当 参数 是 一 个 字符 串 ， 而 且 是 一 个 能 够 识 
别 的 日 期 ， 则 可 以 成 功 转换 。 当 参数 是 一 个 数字 ， 则 数字 0 相当 于 机 899/12/30 00:00:00#， 例 
如 : CDate(20.75) 转换 成 日 期 所 900/1/19 18:00:00#。 

CDbl(#1900/1/19 18:00:00 # 把 日 期 时 间 转 换 为 数字 ， 结 果 是 20.75。 

运行 上 述 过 程 ， 立 即 窗口 的 结果 如 图 143 所 示 。 


注意 字符 串 能 否 转换 为 日 期 时 间 ， 可 以 用 2015/7/8 


IsDate 判断 ， 如 果 返 回 Tue， 则 可 以 用 CDate 进 “| 20i3/778 2015/7/8 15:30:00 
行 转换 。 1955/3/2 


图 14-3 日 期 和 时 间 的 生成 


Sub 事先 判断 () 
Dim s As String 
s = "15 点 30 分 21 秒 " 
If IsDate(s) Then 
Debug.Print CDate(s) 
Else 
Debug .Print "无 法 转换 " 
End If 
End Sub 
上 述 程序 返回 “无 法 转换 *"， 因 为 VBA 不 认识 15 点 ， 如 果 改 成 15 时 ， 则 可 以 转换 为 
日 期 。 
另外 ，DateSerial 和 TimeSerial 中 的 参数 还 可 以 是 负数 ,例如 下 面 这 两 行 代码 。 
DateSerial (2018,1,-5) 返回 日 期 # 2017/12/26 # 
TimeSerial (13, -5, -3) 返回 时 间 #12:54:57# 


14.5.3 ”日 期 时 间 的 格式 化 


Format 函数 中 的 格式 字符 串 中 , 年、 月 、 日 分 别 用 y、m、d 表示 ， 时 分 秒 用 hn.s 表示 。 

例如 : 年 份 的 表达 形式 中 ，yyyy 表示 2018，yy 表示 18。 

其 他 分 量 最 多 是 两 位 数 ， 因 此 一 个 字母 表示 没有 前 导 零 。 例 如 mm 表示 07, 而 m 表 
未 7s 
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Sub 日 期 时 间 的 格式 化 输出 () ll 
Dim dt As Date 15:02:45 18/07/10 
dt = #7/10/2018 3:02:45 PM# ee 
Debug.Print Format (dt, "hh:nn:ss yy/mm/dd") 星期 二 
Debug.Print Format (dt, "aaa") Te 
Debug.Print Format (dt, "aaaa") 
Debug.Print Format (dt, "ddd") 
Debug.Print Format (dt, "dddd") 图 14-4 格式 化 输出 日 期 


End Sub 


运行 上 述 过 程 ， 立 即 窗口 的 结果 如 图 14-4 所 示 。 


14.5.4 ”计算 两 个 日 期 的 差 


DateDiff 函数 用 于 计算 两 个 日 期 的 差 ， 必需 参 数 有 以 下 3 个 。 
口 Interval: 差 值 的 表现 形式 。 

口 Datel: 前 面 的 日 期 。 

口 Date2: 后 面 的 日 期 。 

下 面 的 程序 用 来 计算 两 个 日 期 相差 的 天 数 。 


Sub 计算 两 个 日 期 的 差 () 

Dim dtl Rs Date, dt2 As Date 

dtl = #7/10/2018 1:08:00 PM# 

dt2 = #8/4/2018 5:15:21 AM# 

Debug.Print DateDiff(Interval:="d", Datel:=dtl, Date2:=dt2) 
End Sub 


运行 上 述 程 序 ， 返 回 25， 表 示 后 一 个 日 期 比 前 一 个 日 期 大 25 天 。 
如 果 把 "d" 换 成 "h"， 则 计算 两 个 日 期 相差 的 小 时 数 。 


14.5.5 “日 期 与 数字 的 加 减 


DateAdd 函数 用 于 计算 两 个 日 期 的 差 .， 必需 参数 有 以 下 3 个 。 

口 Interval: 差 值 的 表现 形式 。 

口 Number: 需要 加 减 的 数字 ， 正 数 负 数 均 可 。 

口 Date: 基准 日 期 。 

需要 注意 的 是 ，DataAdd 函数 所 需 的 参数 是 一 个 日 期 和 一 个 数字 ， 结 果 返 回 的 是 另 一 
个 日 期 。 


Sub 日 期 与 时 间 的 加 减 () 
Dim qtl As Date, dt2 As Date 
qtl = #7/10/2018 1:08:00 PM# 
dt2 = DateAdd (Interval:="m", Number:=-10, Date:=dt1) 
Debug.Print dt2 
End Sub 


上 述 程序 的 作用 是 ， 以 #7/10/2018 1:08:00 PM# 为 基准 日 期 ， 向 前 推 10 个 月 ， 运 行 结 
果 是 : #2017/9/10 13:08:00#。 
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14.5.6 ”常见 日 期 信息 获取 


在 实际 编程 中 ， 经 常 需要 获取 基于 现在 的 其 他 日 期 。 
Sub 基于 现在 的 日 期 () 


Debug.Print 
Debug.Print 
Debug.Print 
Debug .Print 
Debug.Print 
Debug.Print 
Debug.Print 
Debug.Print 
Debug.Print 
End Sub 


"今天 "，Date 

"昨天 "，DateAdd("d",， -1, Date) 
"明天 "，DateAdd("d", 1, Date) 
"上 周 "，DateAdd ("ww"，-1，Date) 
"下 周 "，DateAdd ("ww", 1, Date) 
"上 月 ",， DateAdd("m", -1, Date) 
"下 月 ",，DateAdd("m", 1, Date) 
"去 年 "，DateRdd ("yyyy",， -1, Date) 
"明年 "，DateAdd ("yyyy", 1, Date) 


运行 上 述 程 序 ， 立 即 窗口 的 结果 如 图 14-5 所 示 。 
下 面 的 程序 获取 基于 当前 时 刻 的 其 他 时 刻 。 


Sub 基于 现在 的 时 间 () 


Debug.Print 
Debug.Print 
Debug.Print 
Debug.Print 


"现在 时 刻 "，Now 

"15 小 时 前 "，DateAdd ("h"，-15，Now) 
"45 分 钟 后 "，DateAdd ("n"，45，Now) 
"30 秒 后 "，DateAdd("s"，30，Now) 


今天 2018/7/7 
昨天 2018/7/6 
明天 2018/7/8 
上 周 2018/6/30 
下 周 2018/7/14 
上 月 2018/6/7 
下 月 2018/8/7 
去 年 2017/7/7 
明年 2019/7/7 


图 14-5 ”基于 今天 的 其 他 日 期 


End Sub 
运行 上 述 程 序 ， 立 即 窗 口 的 结果 如 图 14-6 [ES 
所 示 现在 时 刻 2018/7/7 8:58:16 
hs 15 小 时 前 2018/7/6 17:58:16 
此 外 ， 还 经 常 遇 到 计算 上 月 月 初 、 上 月 月 末 的 “| 多 针 中。 2018/7/7 :3:16 


日 期 ， 以 及 计算 本 周一 的 日 期 等 。 
上 月 月 初 的 计算 ， 


需要 在 现在 的 基础 上 减 去 一 


个 月 就 可 以 了 ,月 初始 终 是 1 号 ， 因 此 是 : 


DateSerial (Year (Date) ，Month (Date) - 1, 1) 


上 月 月 末 的 计算 非常 简单 ， 从 今天 的 日 期 减 去 今天 的 天 数 即 可 ， 也 就 是 : 


Date - Day (Date) 


也 可 以 写成 : 


DateAdd("d", -Day(Date), Date) 


本 周 周一 的 计算 ,在 今天 的 基础 上 减 去 今天 的 星期 ， 再 加 上 1 即 可 。 


Date - Weekday (Date, vbMonday) + 1 


如 果 要 计算 本 周 四 的 日 期 ， 修 改 为 : 


Date - Weekday (Date, vbMonday) + 4 


以 上 程序 的 源 代码 文件 为 “实例 文档 100.xlsm”。 


图 14-6 今天 当前 时 间 的 其 他 时 间 


14.6 ”本 音 小 结 


随机 数 在 编程 开发 中 具有 很 重要 的 地 位 ， 例 如 抽奖 、 扑 克 牌 游戏 的 编制 都 离 不 开 随 
机 数 。 

在 VBA 中 ,日 期 和 时 间 与 数字 具有 对 应 关系 ， 日 期 和 时 间 可 以 与 数字 直接 加 减 。 

两 个 日 期 相 减 的 意义 是 两 个 日 期 相隔 的 天 数 ， 两 个 日 期 也 可 以 相 加 、 相 乘 、 相 除 ， 但 没 


